[PATCH, Fortran] PR78277: ICE in is_anonymous_component, at fortran/interface.c:450
Fritz Reese
fritzoreese@gmail.com
Thu Nov 10 19:06:00 GMT 2016
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 <fritzoreese@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 <fritzoreese@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.
<<<<<
-------------- next part --------------
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
-------------- next part --------------
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;
}
More information about the Fortran
mailing list