diff mbox

[Fortran] PR78277: ICE in is_anonymous_component, at fortran/interface.c:450

Message ID CAE4aFAn5MGyPH2zCk5v2zXq1TkyTKY5xJR2Fdps=0oa=QWEY8g@mail.gmail.com
State New
Headers show

Commit Message

Fritz Reese Nov. 10, 2016, 7:06 p.m. UTC 
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.
<<<<<

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;
 }
diff mbox

Patch

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