All, The attached fixes an ICE-on-invalid-code, specifically due to invalid anonymous structure declarations, as seen in the attached test case. This also improves error handling in such cases- the anonymous structure body will continue to be parsed even if the variable-decl after the opening variable-type-decl is invalid. (Something similar could be done to improve regular structure declarations.) See the in-code comments and comments on the on the PR for an additional description
Along with the first patch, I've attached another patch (struct_whitespace) containing whitespace-only changes to some dec-structure-related code; the poor formatting was introduced before I had my vim settings right. I intend to commit the two attached patches soon for trunk if nobody finds any issues with it. They both regtest on x86_64-redhat-linux of course. --- Fritz Reese >>>>> pr78277.diff From: Fritz O. Reese <fritzore...@gmail.com> Date: Thu, 10 Nov 2016 13:36:54 -0500 Subject: [PATCH] Fix ICE and improve errors for invalid anonymous structure declarations. PR fortran/78277 * gcc/fortran/decl.c (gfc_match_data_decl): Gracefully handle bad anonymous structure declarations. PR fortran/78277 * gcc/testsuite/gfortran.dg/dec_structure_17.f90: New test. <<<<< >>>>> struct_whitespace.diff From: Fritz O. Reese <fritzore...@gmail.com> Date: Thu, 10 Nov 2016 11:02:08 -0500 Subject: [PATCH] Fix some whitespace. gcc/fortran/ * decl.c (get_struct_decl, gfc_match_map, gfc_match_union): Fix whitespace. * interface.c (gfc_compare_union_types): Likewise. <<<<<
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 1272f1f..bf6bc24 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -4901,7 +4901,28 @@ ok: } if (!gfc_error_flag_test ()) - gfc_error ("Syntax error in data declaration at %C"); + { + /* An anonymous structure declaration is unambiguous; if we matched one + according to gfc_match_structure_decl, we need to return MATCH_YES + here to avoid confusing the remaining matchers, even if there was an + error during variable_decl. We must flush any such errors. Note this + causes the parser to gracefully continue parsing the remaining input + as a structure body, which likely follows. */ + if (current_ts.type == BT_DERIVED && current_ts.u.derived + && gfc_fl_struct (current_ts.u.derived->attr.flavor)) + { + gfc_error_now ("Syntax error in anonymous structure declaration" + " at %C"); + /* Skip the bad variable_decl and line up for the start of the + structure body. */ + gfc_error_recovery (); + m = MATCH_YES; + goto cleanup; + } + + gfc_error ("Syntax error in data declaration at %C"); + } + m = MATCH_ERROR; gfc_free_data_all (gfc_current_ns); diff --git a/gcc/testsuite/gfortran.dg/dec_structure_17.f90 b/gcc/testsuite/gfortran.dg/dec_structure_17.f90 new file mode 100644 index 0000000..18d3193 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_17.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! { dg-options "-fdec-structure" } +! +! PR fortran/78277 +! +! Fix ICE for invalid structure declaration code. +! + +subroutine sub1() + structure /s/ + structure t + integer i + end structure + end structure + record /s/ u + interface + subroutine sub0(u) + structure /s/ + structure t. ! { dg-error "Syntax error in anonymous structure decl" } + integer i + end structure + end structure + record /s/ u + end + end interface + call sub0(u) +end
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 0120ceb..1272f1f 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -8597,31 +8597,31 @@ get_struct_decl (const char *name, sym_flavor fl, locus *decl, match gfc_match_map (void) { - /* Counter used to give unique internal names to map structures. */ - static unsigned int gfc_map_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; - gfc_symbol *sym; - locus old_loc; + /* Counter used to give unique internal names to map structures. */ + static unsigned int gfc_map_id = 0; + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol *sym; + locus old_loc; - old_loc = gfc_current_locus; + old_loc = gfc_current_locus; - if (gfc_match_eos () != MATCH_YES) - { - gfc_error ("Junk after MAP statement at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; - } + if (gfc_match_eos () != MATCH_YES) + { + gfc_error ("Junk after MAP statement at %C"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } - /* Map blocks are anonymous so we make up unique names for the symbol table - which are invalid Fortran identifiers. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "MM$%u", gfc_map_id++); + /* Map blocks are anonymous so we make up unique names for the symbol table + which are invalid Fortran identifiers. */ + snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "MM$%u", gfc_map_id++); - if (!get_struct_decl (name, FL_STRUCT, &old_loc, &sym)) - return MATCH_ERROR; + if (!get_struct_decl (name, FL_STRUCT, &old_loc, &sym)) + return MATCH_ERROR; - gfc_new_block = sym; + gfc_new_block = sym; - return MATCH_YES; + return MATCH_YES; } @@ -8630,31 +8630,31 @@ gfc_match_map (void) match gfc_match_union (void) { - /* Counter used to give unique internal names to union types. */ - static unsigned int gfc_union_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; - gfc_symbol *sym; - locus old_loc; + /* Counter used to give unique internal names to union types. */ + static unsigned int gfc_union_id = 0; + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol *sym; + locus old_loc; - old_loc = gfc_current_locus; + old_loc = gfc_current_locus; - if (gfc_match_eos () != MATCH_YES) - { - gfc_error ("Junk after UNION statement at %C"); - gfc_current_locus = old_loc; - return MATCH_ERROR; - } + if (gfc_match_eos () != MATCH_YES) + { + gfc_error ("Junk after UNION statement at %C"); + gfc_current_locus = old_loc; + return MATCH_ERROR; + } - /* Unions are anonymous so we make up unique names for the symbol table - which are invalid Fortran identifiers. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "UU$%u", gfc_union_id++); + /* Unions are anonymous so we make up unique names for the symbol table + which are invalid Fortran identifiers. */ + snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "UU$%u", gfc_union_id++); - if (!get_struct_decl (name, FL_UNION, &old_loc, &sym)) - return MATCH_ERROR; + if (!get_struct_decl (name, FL_UNION, &old_loc, &sym)) + return MATCH_ERROR; - gfc_new_block = sym; + gfc_new_block = sym; - return MATCH_YES; + return MATCH_YES; } @@ -8666,67 +8666,67 @@ gfc_match_union (void) match gfc_match_structure_decl (void) { - /* Counter used to give unique internal names to anonymous structures. */ - static unsigned int gfc_structure_id = 0; - char name[GFC_MAX_SYMBOL_LEN + 1]; - gfc_symbol *sym; - match m; - locus where; + /* Counter used to give unique internal names to anonymous structures. */ + static unsigned int gfc_structure_id = 0; + char name[GFC_MAX_SYMBOL_LEN + 1]; + gfc_symbol *sym; + match m; + locus where; - if(!flag_dec_structure) - { - gfc_error ("STRUCTURE at %C is a DEC extension, enable with " - "-fdec-structure"); - return MATCH_ERROR; - } + if (!flag_dec_structure) + { + gfc_error ("STRUCTURE at %C is a DEC extension, enable with " + "-fdec-structure"); + return MATCH_ERROR; + } - name[0] = '\0'; + name[0] = '\0'; - m = gfc_match (" /%n/", name); - if (m != MATCH_YES) - { - /* Non-nested structure declarations require a structure name. */ - if (!gfc_comp_struct (gfc_current_state ())) - { - gfc_error ("Structure name expected in non-nested structure " - "declaration at %C"); - return MATCH_ERROR; - } - /* This is an anonymous structure; make up a unique name for it - (upper-case letters never make it to symbol names from the source). - The important thing is initializing the type variable - and setting gfc_new_symbol, which is immediately used by - parse_structure () and variable_decl () to add components of - this type. */ - snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "SS$%u", gfc_structure_id++); - } + m = gfc_match (" /%n/", name); + if (m != MATCH_YES) + { + /* Non-nested structure declarations require a structure name. */ + if (!gfc_comp_struct (gfc_current_state ())) + { + gfc_error ("Structure name expected in non-nested structure " + "declaration at %C"); + return MATCH_ERROR; + } + /* This is an anonymous structure; make up a unique name for it + (upper-case letters never make it to symbol names from the source). + The important thing is initializing the type variable + and setting gfc_new_symbol, which is immediately used by + parse_structure () and variable_decl () to add components of + this type. */ + snprintf (name, GFC_MAX_SYMBOL_LEN + 1, "SS$%u", gfc_structure_id++); + } - where = gfc_current_locus; - /* No field list allowed after non-nested structure declaration. */ - if (!gfc_comp_struct (gfc_current_state ()) - && gfc_match_eos () != MATCH_YES) - { - gfc_error ("Junk after non-nested STRUCTURE statement at %C"); - return MATCH_ERROR; - } + where = gfc_current_locus; + /* No field list allowed after non-nested structure declaration. */ + if (!gfc_comp_struct (gfc_current_state ()) + && gfc_match_eos () != MATCH_YES) + { + gfc_error ("Junk after non-nested STRUCTURE statement at %C"); + return MATCH_ERROR; + } - /* Make sure the name is not the name of an intrinsic type. */ - if (gfc_is_intrinsic_typename (name)) - { - gfc_error ("Structure name '%s' at %C cannot be the same as an" - " intrinsic type", name); - return MATCH_ERROR; - } + /* Make sure the name is not the name of an intrinsic type. */ + if (gfc_is_intrinsic_typename (name)) + { + gfc_error ("Structure name '%s' at %C cannot be the same as an" + " intrinsic type", name); + return MATCH_ERROR; + } - /* Store the actual type symbol for the structure with an upper-case first - letter (an invalid Fortran identifier). */ + /* Store the actual type symbol for the structure with an upper-case first + letter (an invalid Fortran identifier). */ - sprintf (name, gfc_dt_upper_string (name)); - if (!get_struct_decl (name, FL_STRUCT, &where, &sym)) - return MATCH_ERROR; + sprintf (name, gfc_dt_upper_string (name)); + if (!get_struct_decl (name, FL_STRUCT, &where, &sym)) + return MATCH_ERROR; - gfc_new_block = sym; - return MATCH_YES; + gfc_new_block = sym; + return MATCH_YES; } diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index b851d5a..e231bd2 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -558,46 +558,46 @@ gfc_compare_union_types (gfc_symbol *un1, gfc_symbol *un2) we will say they are not equal for the purposes of this test; therefore we compare the maps sequentially. */ for (;;) - { - map1_t = map1->ts.u.derived; - map2_t = map2->ts.u.derived; + { + map1_t = map1->ts.u.derived; + map2_t = map2->ts.u.derived; - cmp1 = map1_t->components; - cmp2 = map2_t->components; + cmp1 = map1_t->components; + cmp2 = map2_t->components; - /* Protect against null components. */ - if (map1_t->attr.zero_comp != map2_t->attr.zero_comp) - return 0; + /* Protect against null components. */ + if (map1_t->attr.zero_comp != map2_t->attr.zero_comp) + return 0; - if (map1_t->attr.zero_comp) - return 1; + if (map1_t->attr.zero_comp) + return 1; - for (;;) - { - /* No two fields will ever point to the same map type unless they are - the same component, because one map field is created with its type - declaration. Therefore don't worry about recursion here. */ - /* TODO: worry about recursion into parent types of the unions? */ - if (compare_components (cmp1, cmp2, map1_t, map2_t) == 0) - return 0; + for (;;) + { + /* No two fields will ever point to the same map type unless they are + the same component, because one map field is created with its type + declaration. Therefore don't worry about recursion here. */ + /* TODO: worry about recursion into parent types of the unions? */ + if (compare_components (cmp1, cmp2, map1_t, map2_t) == 0) + return 0; - cmp1 = cmp1->next; - cmp2 = cmp2->next; + cmp1 = cmp1->next; + cmp2 = cmp2->next; - if (cmp1 == NULL && cmp2 == NULL) - break; - if (cmp1 == NULL || cmp2 == NULL) - return 0; - } + if (cmp1 == NULL && cmp2 == NULL) + break; + if (cmp1 == NULL || cmp2 == NULL) + return 0; + } - map1 = map1->next; - map2 = map2->next; + map1 = map1->next; + map2 = map2->next; - if (map1 == NULL && map2 == NULL) - break; - if (map1 == NULL || map2 == NULL) - return 0; - } + if (map1 == NULL && map2 == NULL) + break; + if (map1 == NULL || map2 == NULL) + return 0; + } return 1; }