From f5acf0f24b8d53cb754c4ece3b5b54cbd4abb461 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 12 Jan 2013 12:52:41 +0000 Subject: [PATCH] re PR fortran/55868 (gfortran generates for CLASS(*) __m_MOD___vtab__$tar on NO_DOLLAR_IN_LABEL systems) 2013-01-08 Paul Thomas PR fortran/55868 * class.c (get_unique_type_string): Change $tar to STAR and replace sprintf by strcpy where there is no formatting. * decl.c (gfc_match_decl_type_spec): Change $tar to STAR. 2013-01-08 Paul Thomas PR fortran/55868 * gfortran.dg/unlimited_polymorphic_8.f90: Update scan-tree-dump-times for foo.0.x._vptr to deal with change from $tar to STAR. From-SVN: r195124 --- gcc/fortran/ChangeLog | 7 + gcc/fortran/class.c | 4 +- gcc/fortran/decl.c | 176 ++++++++++----------- gcc/testsuite/ChangeLog | 7 + .../gfortran.dg/unlimited_polymorphic_8.f90 | 2 +- 5 files changed, 105 insertions(+), 91 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index cfaae77..54700c6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-01-08 Paul Thomas + + PR fortran/55868 + * class.c (get_unique_type_string): Change $tar to STAR and + replace sprintf by strcpy where there is no formatting. + * decl.c (gfc_match_decl_type_spec): Change $tar to STAR. + 2013-01-09 Mikael Morin PR fortran/47203 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 6dfa899..3bb326c 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -460,9 +460,9 @@ get_unique_type_string (char *string, gfc_symbol *derived) { char dt_name[GFC_MAX_SYMBOL_LEN+1]; if (derived->attr.unlimited_polymorphic) - sprintf (dt_name, "%s", "$tar"); + strcpy (dt_name, "STAR"); else - sprintf (dt_name, "%s", derived->name); + strcpy (dt_name, derived->name); dt_name[0] = TOUPPER (dt_name[0]); if (derived->attr.unlimited_polymorphic) sprintf (string, "_%s", dt_name); diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 427d562..f2a9941 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -737,7 +737,7 @@ match_char_length (gfc_expr **expr, bool *deferred, bool obsolescent_check) int length; match m; - *deferred = false; + *deferred = false; m = gfc_match_char ('*'); if (m != MATCH_YES) return m; @@ -988,7 +988,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym) Don't repeat the checks here. */ if (sym->attr.implicit_type) return SUCCESS; - + /* For subroutines or functions that are passed to a BIND(C) procedure, they're interoperable if they're BIND(C) and their params are all interoperable. */ @@ -999,7 +999,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym) gfc_error_now ("Procedure '%s' at %L must have the BIND(C) " "attribute to be C interoperable", sym->name, &(sym->declared_at)); - + return FAILURE; } else @@ -1012,7 +1012,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym) sym->common_block); } } - + /* See if we've stored a reference to a procedure that owns sym. */ if (sym->ns != NULL && sym->ns->proc_name != NULL) { @@ -1028,7 +1028,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym) "BIND(C) procedure '%s' but is not C interoperable " "because derived type '%s' is not C interoperable", sym->name, &(sym->declared_at), - sym->ns->proc_name->name, + sym->ns->proc_name->name, sym->ts.u.derived->name); else if (sym->ts.type == BT_CLASS) gfc_error ("Variable '%s' at %L is a dummy argument to the " @@ -1350,7 +1350,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) until later for derived type variables and procedure pointers. */ if (sym->ts.type != BT_DERIVED && init->ts.type != BT_DERIVED && sym->ts.type != BT_CLASS && init->ts.type != BT_CLASS - && !sym->attr.proc_pointer + && !sym->attr.proc_pointer && gfc_check_assign_symbol (sym, NULL, init) == FAILURE) return FAILURE; @@ -1436,7 +1436,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) int k; gfc_expr* lower; gfc_expr* e; - + lower = sym->as->lower[dim]; if (lower->expr_type != EXPR_CONSTANT) { @@ -1498,7 +1498,7 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) ? init : gfc_copy_expr (init), &init->where); - + array->shape = gfc_get_shape (sym->as->rank); for (n = 0; n < sym->as->rank; n++) spec_dimen_size (sym->as, n, &array->shape[n]); @@ -1759,7 +1759,7 @@ match_pointer_init (gfc_expr **init, int procptr) if (!procptr) gfc_resolve_expr (*init); - + if (gfc_notify_std (GFC_STD_F2008, "non-NULL pointer " "initialization at %C") == FAILURE) return MATCH_ERROR; @@ -1919,7 +1919,7 @@ variable_decl (int elem) sym->ts.is_c_interop = current_ts.is_c_interop; sym->ts.is_iso_c = current_ts.is_iso_c; m = MATCH_YES; - + /* Check to see if we have an array specification. */ if (cp_as != NULL) { @@ -2002,7 +2002,7 @@ variable_decl (int elem) goto cleanup; } } - + if (check_function_name (name) == FAILURE) { m = MATCH_ERROR; @@ -2023,7 +2023,7 @@ variable_decl (int elem) if (gfc_notify_std (GFC_STD_GNU, "Old-style " "initialization at %C") == FAILURE) return MATCH_ERROR; - + return match_old_style_init (name); } @@ -2218,7 +2218,7 @@ kind_expr: { if (gfc_matching_function) { - /* The function kind expression might include use associated or + /* The function kind expression might include use associated or imported parameters and try again after the specification expressions..... */ if (gfc_match_char (')') != MATCH_YES) @@ -2267,7 +2267,7 @@ kind_expr: ts->is_c_interop = e->ts.is_iso_c; ts->f90_type = e->ts.f90_type; } - + gfc_free_expr (e); e = NULL; @@ -2362,7 +2362,7 @@ match_char_kind (int * kind, int * is_iso_c) if (n != MATCH_YES && gfc_matching_function) { /* The expression might include use-associated or imported - parameters and try again after the specification + parameters and try again after the specification expressions. */ gfc_free_expr (e); gfc_undo_symbols (); @@ -2405,7 +2405,7 @@ match_char_kind (int * kind, int * is_iso_c) if (m == MATCH_ERROR) gfc_current_locus = where; - + /* Return what we know from the test(s). */ return m; @@ -2457,7 +2457,7 @@ gfc_match_char_spec (gfc_typespec *ts) if (gfc_match (" kind =") == MATCH_YES) { m = match_char_kind (&kind, &is_iso_c); - + if (m == MATCH_ERROR) goto done; if (m == MATCH_NO) @@ -2572,11 +2572,11 @@ done: looking for the length (line 1690, roughly). it's the last testcase for parsing the kind params of a character variable. However, it's not actually the length. this seems like it - could be an error. + could be an error. To see if the user used a C interop kind, test the expr of the so called length, and see if it's C interoperable. */ ts->is_c_interop = len->ts.is_iso_c; - + return MATCH_YES; } @@ -2764,11 +2764,11 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) gfc_symbol *upe; gfc_symtree *st; ts->type = BT_CLASS; - gfc_find_symbol ("$tar", gfc_current_ns, 1, &upe); + gfc_find_symbol ("STAR", gfc_current_ns, 1, &upe); if (upe == NULL) { - upe = gfc_new_symbol ("$tar", gfc_current_ns); - st = gfc_new_symtree (&gfc_current_ns->sym_root, "$tar"); + upe = gfc_new_symbol ("STAR", gfc_current_ns); + st = gfc_new_symtree (&gfc_current_ns->sym_root, "STAR"); st->n.sym = upe; gfc_set_sym_referenced (upe); upe->refs++; @@ -2783,9 +2783,9 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) } else { - st = gfc_find_symtree (gfc_current_ns->sym_root, "$tar"); + st = gfc_find_symtree (gfc_current_ns->sym_root, "STAR"); if (st == NULL) - st = gfc_new_symtree (&gfc_current_ns->sym_root, "$tar"); + st = gfc_new_symtree (&gfc_current_ns->sym_root, "STAR"); st->n.sym = upe; upe->refs++; } @@ -2805,7 +2805,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) /* Defer association of the derived type until the end of the specification block. However, if the derived type can be - found, add it to the typespec. */ + found, add it to the typespec. */ if (gfc_matching_function) { ts->u.derived = NULL; @@ -2846,7 +2846,7 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) || gfc_current_ns->has_import_set; gfc_find_symbol (name, NULL, iface, &sym); if (sym && sym->generic && gfc_find_symbol (dt_name, NULL, 1, &dt_sym)) - { + { gfc_error ("Type name '%s' at %C is ambiguous", name); return MATCH_ERROR; } @@ -3836,7 +3836,7 @@ match_attr_spec (void) case DECL_IS_BIND_C: t = gfc_add_is_bind_c(¤t_attr, NULL, &seen_at[d], 0); break; - + case DECL_VALUE: if (gfc_notify_std (GFC_STD_F2003, "VALUE attribute " "at %C") @@ -3889,7 +3889,7 @@ cleanup: there is more than one argument (num_idents), it is an error. */ static gfc_try -set_binding_label (const char **dest_label, const char *sym_name, +set_binding_label (const char **dest_label, const char *sym_name, int num_idents) { if (num_idents > 1 && has_name_equals) @@ -3909,7 +3909,7 @@ set_binding_label (const char **dest_label, const char *sym_name, if (sym_name != NULL && has_name_equals == 0) *dest_label = IDENTIFIER_POINTER (get_identifier (sym_name)); } - + return SUCCESS; } @@ -3954,7 +3954,7 @@ verify_com_block_vars_c_interop (gfc_common_head *com_block) gfc_try retval = SUCCESS; curr_sym = com_block->head; - + /* Make sure we have at least one symbol. */ if (curr_sym == NULL) return retval; @@ -3966,7 +3966,7 @@ verify_com_block_vars_c_interop (gfc_common_head *com_block) /* The second to last param, 1, says this is in a common block. */ retval = verify_bind_c_sym (curr_sym, &(curr_sym->ts), 1, com_block); curr_sym = curr_sym->common_next; - } while (curr_sym != NULL); + } while (curr_sym != NULL); return retval; } @@ -4005,7 +4005,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, enough type info, then verify that it's a C interop kind. The info could be in the symbol already, or possibly still in the given ts (current_ts), so look in both. */ - if (tmp_sym->ts.type != BT_UNKNOWN || ts->type != BT_UNKNOWN) + if (tmp_sym->ts.type != BT_UNKNOWN || ts->type != BT_UNKNOWN) { if (gfc_verify_c_interop (&(tmp_sym->ts)) != SUCCESS) { @@ -4031,7 +4031,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, tmp_sym->name, &(tmp_sym->declared_at)); } } - + /* Variables declared w/in a common block can't be bind(c) since there's no way for C to see these variables, so there's semantically no reason for the attribute. */ @@ -4044,7 +4044,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, &(tmp_sym->declared_at)); retval = FAILURE; } - + /* Scalar variables that are bind(c) can not have the pointer or allocatable attributes. */ if (tmp_sym->attr.is_bind_c == 1) @@ -4107,7 +4107,7 @@ gfc_try set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents) { gfc_try retval = SUCCESS; - + /* TODO: Do we need to make sure the vars aren't marked private? */ /* Set the is_bind_c bit in symbol_attribute. */ @@ -4128,9 +4128,9 @@ gfc_try set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents) { gfc_try retval = SUCCESS; - + /* destLabel, common name, typespec (which may have binding label). */ - if (set_binding_label (&com_block->binding_label, com_block->name, + if (set_binding_label (&com_block->binding_label, com_block->name, num_idents) != SUCCESS) return FAILURE; @@ -4153,7 +4153,7 @@ get_bind_c_idents (void) gfc_symbol *tmp_sym = NULL; match found_id; gfc_common_head *com_block = NULL; - + if (gfc_match_name (name) == MATCH_YES) { found_id = MATCH_YES; @@ -4170,7 +4170,7 @@ get_bind_c_idents (void) "attribute specification statement at %C"); return FAILURE; } - + /* Save the current identifier and look for more. */ do { @@ -4180,7 +4180,7 @@ get_bind_c_idents (void) /* Make sure we have a sym or com block, and verify that it can be bind(c). Set the appropriate field(s) and look for more identifiers. */ - if (tmp_sym != NULL || com_block != NULL) + if (tmp_sym != NULL || com_block != NULL) { if (tmp_sym != NULL) { @@ -4194,7 +4194,7 @@ get_bind_c_idents (void) != SUCCESS) return FAILURE; } - + /* Look to see if we have another identifier. */ tmp_sym = NULL; if (gfc_match_eos () == MATCH_YES) @@ -4230,7 +4230,7 @@ get_bind_c_idents (void) /* Try and match a BIND(C) attribute specification statement. */ - + match gfc_match_bind_c_stmt (void) { @@ -4238,7 +4238,7 @@ gfc_match_bind_c_stmt (void) gfc_typespec *ts; ts = ¤t_ts; - + /* This may not be necessary. */ gfc_clear_ts (ts); /* Clear the temporary binding label holder. */ @@ -4276,7 +4276,7 @@ gfc_match_data_decl (void) int elem; num_idents_on_line = 0; - + m = gfc_match_decl_type_spec (¤t_ts, 0); if (m != MATCH_YES) return m; @@ -4662,7 +4662,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) /* Initialize to having found nothing. */ found_match = MATCH_NO; - is_bind_c = MATCH_NO; + is_bind_c = MATCH_NO; is_result = MATCH_NO; /* Get the next char to narrow between result and bind(c). */ @@ -4690,7 +4690,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) } else /* This should only be MATCH_ERROR. */ - found_match = is_result; + found_match = is_result; break; case 'b': /* Look for bind(c) first. */ @@ -4728,7 +4728,7 @@ gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) == FAILURE) return MATCH_ERROR; } - + return found_match; } @@ -4940,7 +4940,7 @@ match_procedure_decl (void) return MATCH_ERROR; } /* Set binding label for BIND(C). */ - if (set_binding_label (&sym->binding_label, sym->name, num) + if (set_binding_label (&sym->binding_label, sym->name, num) != SUCCESS) return MATCH_ERROR; } @@ -5263,7 +5263,7 @@ gfc_match_function_decl (void) locus old_loc; match m; match suffix_match; - match found_match; /* Status returned by match func. */ + match found_match; /* Status returned by match func. */ if (gfc_current_state () != COMP_NONE && gfc_current_state () != COMP_INTERFACE @@ -5346,10 +5346,10 @@ gfc_match_function_decl (void) { /* Make changes to the symbol. */ m = MATCH_ERROR; - + if (gfc_add_function (&sym->attr, sym->name, NULL) == FAILURE) goto cleanup; - + if (gfc_missing_attr (&sym->attr, NULL) == FAILURE || copy_prefix (&sym->attr, &sym->declared_at) == FAILURE) goto cleanup; @@ -5536,7 +5536,7 @@ gfc_match_entry (void) gfc_error_now ("BIND(C) attribute at %L can only be used for " "variables or common blocks", &gfc_current_locus); } - + /* Check what next non-whitespace character is so we can tell if there is the required parens if we have a BIND(C). */ gfc_gobble_whitespace (); @@ -5705,7 +5705,7 @@ gfc_match_subroutine (void) is the required parens if we have a BIND(C). */ gfc_gobble_whitespace (); peek_char = gfc_peek_ascii_char (); - + if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE) return MATCH_ERROR; @@ -5766,7 +5766,7 @@ gfc_match_subroutine (void) == FAILURE) return MATCH_ERROR; } - + if (gfc_match_eos () != MATCH_YES) { gfc_syntax_error (ST_SUBROUTINE); @@ -5797,12 +5797,12 @@ gfc_match_subroutine (void) match gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name) { - /* binding label, if exists */ + /* binding label, if exists */ const char* binding_label = NULL; match double_quote; match single_quote; - /* Initialize the flag that specifies whether we encountered a NAME= + /* Initialize the flag that specifies whether we encountered a NAME= specifier or not. */ has_name_equals = 0; @@ -5837,12 +5837,12 @@ gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name) "at %C"); return MATCH_ERROR; } - + /* Grab the binding label, using functions that will not lower case the names automatically. */ if (gfc_match_name_C (&binding_label) != MATCH_YES) return MATCH_ERROR; - + /* Get the closing quotation. */ if (double_quote == MATCH_YES) { @@ -6236,7 +6236,7 @@ attr_decl1 (void) m = MATCH_ERROR; goto cleanup; } - + var_locus = gfc_current_locus; /* Deal with possible array specification for certain attributes. */ @@ -6307,7 +6307,7 @@ attr_decl1 (void) goto cleanup; } } - + if (sym->ts.type == BT_CLASS && gfc_build_class_symbol (&sym->ts, &sym->attr, &sym->as, false) == FAILURE) { @@ -6324,7 +6324,7 @@ attr_decl1 (void) if (sym->attr.cray_pointee && sym->as != NULL) { /* Fix the array spec. */ - m = gfc_mod_pointee_as (sym->as); + m = gfc_mod_pointee_as (sym->as); if (m == MATCH_ERROR) goto cleanup; } @@ -6485,7 +6485,7 @@ cray_pointer_decl (void) { gfc_free_array_spec (as); as = NULL; - } + } if (gfc_add_cray_pointee (&cpte->attr, &var_locus) == FAILURE) return MATCH_ERROR; @@ -6503,31 +6503,31 @@ cray_pointer_decl (void) gfc_free_array_spec (as); return MATCH_ERROR; } - + as = NULL; - + if (cpte->as != NULL) { /* Fix array spec. */ m = gfc_mod_pointee_as (cpte->as); if (m == MATCH_ERROR) return m; - } - + } + /* Point the Pointee at the Pointer. */ cpte->cp_pointer = cptr; if (gfc_match_char (')') != MATCH_YES) { gfc_error ("Expected \")\" at %C"); - return MATCH_ERROR; + return MATCH_ERROR; } m = gfc_match_char (','); if (m != MATCH_YES) done = true; /* Stop searching for more declarations. */ } - + if (m == MATCH_ERROR /* Failed when trying to find ',' above. */ || gfc_match_eos () != MATCH_YES) { @@ -6618,7 +6618,7 @@ gfc_match_pointer (void) { gfc_clear_attr (¤t_attr); current_attr.pointer = 1; - + return attr_decl (); } } @@ -7163,7 +7163,7 @@ gfc_match_volatile (void) for(;;) { - /* VOLATILE is special because it can be added to host-associated + /* VOLATILE is special because it can be added to host-associated symbols locally. Except for coarrays. */ m = gfc_match_symbol (&sym, 1); switch (m) @@ -7224,7 +7224,7 @@ gfc_match_asynchronous (void) for(;;) { - /* ASYNCHRONOUS is special because it can be added to host-associated + /* ASYNCHRONOUS is special because it can be added to host-associated symbols locally. */ m = gfc_match_symbol (&sym, 1); switch (m) @@ -7308,7 +7308,7 @@ gfc_match_modproc (void) } else gfc_current_locus = old_locus; - + for (;;) { bool last = false; @@ -7622,7 +7622,7 @@ gfc_match_derived_decl (void) /* Construct the f2k_derived namespace if it is not yet there. */ if (!sym->f2k_derived) sym->f2k_derived = gfc_get_namespace (NULL, 0); - + if (extended && !sym->components) { gfc_component *p; @@ -7636,7 +7636,7 @@ gfc_match_derived_decl (void) p->ts.type = BT_DERIVED; p->ts.u.derived = extended; p->initializer = gfc_default_initializer (&p->ts); - + /* Set extension level. */ if (extended->attr.extension == 255) { @@ -7668,7 +7668,7 @@ gfc_match_derived_decl (void) } -/* Cray Pointees can be declared as: +/* Cray Pointees can be declared as: pointer (ipt, a (n,m,...,*)) */ match @@ -7686,15 +7686,15 @@ gfc_mod_pointee_as (gfc_array_spec *as) } -/* Match the enum definition statement, here we are trying to match - the first line of enum definition statement. +/* Match the enum definition statement, here we are trying to match + the first line of enum definition statement. Returns MATCH_YES if match is found. */ match gfc_match_enum (void) { match m; - + m = gfc_match_eos (); if (m != MATCH_YES) return m; @@ -8181,7 +8181,7 @@ match_procedure_in_type (void) return MATCH_ERROR; } - /* Match the binding names. */ + /* Match the binding names. */ for(num=1;;num++) { m = gfc_match_name (name); @@ -8268,7 +8268,7 @@ match_procedure_in_type (void) false)) return MATCH_ERROR; gfc_set_sym_referenced (stree->n.tb->u.specific->n.sym); - + if (gfc_match_eos () == MATCH_YES) return MATCH_YES; if (gfc_match_char (',') != MATCH_YES) @@ -8325,7 +8325,7 @@ gfc_match_generic (void) /* Match the binding name; depending on type (operator / generic) format it for future error messages into bind_name. */ - + m = gfc_match_generic_spec (&op_type, name, &op); if (m == MATCH_ERROR) return MATCH_ERROR; @@ -8340,11 +8340,11 @@ gfc_match_generic (void) case INTERFACE_GENERIC: snprintf (bind_name, sizeof (bind_name), "%s", name); break; - + case INTERFACE_USER_OP: snprintf (bind_name, sizeof (bind_name), "OPERATOR(.%s.)", name); break; - + case INTERFACE_INTRINSIC_OP: snprintf (bind_name, sizeof (bind_name), "OPERATOR(%s)", gfc_op2string (op)); @@ -8360,7 +8360,7 @@ gfc_match_generic (void) gfc_error ("Expected '=>' at %C"); goto error; } - + /* Try to find existing GENERIC binding with this name / for this operator; if there is something, check that it is another GENERIC and then extend it rather than building a new node. Otherwise, create it and put it @@ -8435,7 +8435,7 @@ gfc_match_generic (void) break; } - + case INTERFACE_INTRINSIC_OP: ns->tb_op[op] = tb; break; @@ -8513,7 +8513,7 @@ gfc_match_final_decl (void) if (!gfc_is_whitespace (c) && c != ':') return MATCH_NO; } - + if (gfc_state_stack->state != COMP_DERIVED_CONTAINS) { if (gfc_current_form == FORM_FIXED) @@ -8637,7 +8637,7 @@ const ext_attr_t ext_attr_list[] = { MATCH_NO. */ match gfc_match_gcc_attributes (void) -{ +{ symbol_attribute attr; char name[GFC_MAX_SYMBOL_LEN + 1]; unsigned id; @@ -8692,7 +8692,7 @@ gfc_match_gcc_attributes (void) if (find_special (name, &sym, true)) return MATCH_ERROR; - + sym->attr.ext_attr |= attr.ext_attr; if (gfc_match_eos () == MATCH_YES) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 731bf2c..868f5aa 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2013-01-08 Paul Thomas + + PR fortran/55868 + * gfortran.dg/unlimited_polymorphic_8.f90: Update + scan-tree-dump-times for foo.0.x._vptr to deal with change from + $tar to STAR. + 2013-01-11 Andreas Schwab * gcc.c-torture/compile/pr55921.c: Don't use matching constraints. diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 index e0fa931..8168078 100644 --- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 +++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 @@ -16,5 +16,5 @@ contains end ! { dg-final { scan-tree-dump-times "foo.0.x._data = 0B;" 1 "original" } } -! { dg-final { scan-tree-dump-times "foo.0.x._vptr = .* &__vtab__.tar;" 1 "original" } } +! { dg-final { scan-tree-dump-times "foo.0.x._vptr = .* &__vtab__STAR;" 1 "original" } } ! { dg-final { cleanup-tree-dump "optimized" } } -- 2.7.4