This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[PATCH, Fortran] PR fortran/77584 Re: Unclassifiable statement error with procedure pointer using template named "structure_"


https://gcc.gnu.org/ml/fortran/2016-09/msg00054.html
> On Tue, Sep 13, 2016 at 3:23 PM, Andrew Benson
> <abenson@carnegiescience.edu> wrote:
>> I've opened PR77584
>>
>> https://gcc.gnu.org/bugzilla/show_bug.cgi?id=77584
>>
...
>> The problem seems to occur only if the interface name begins with "structure",
>> so my guess is that this part of the name if being interpreted as a STRUCTURE
>> statement.
>>

The attached patch fixes PR 77584. The match code in
gfc_match_decl_typespec for STRUCTURE/RECORD was a bit greedy and
ambiguous.

For RECORD, the matcher was too broad in its matching and would catch
anything starting with 'record'. I made the code more robust here so
that it looks for 'record /' specifically, and keeps the helpful
warnings for bad record declarations if -fdec-structure is enabled.

For STRUCTURE, the matchers were equally too broad and captured
anything starting with 'structure'. Unfortunately we can't easily
disambiguate it by capturing 'structure /%n/' because a structure
declaration-type-spec might be an anonymous nested structure
declaration, and these have no name ('/%n/'). However a
declaration-type-spec is only valid for structures within other
structures anyway (nested and anonymous structures) - otherwise we
would be in gfc_match_structure_decl directly through decode_statement
in parse.c. So instead of returning MATCH_ERROR when we see
'structure' and are not nested inside a structure, we make sure we are
nested in a structure first and pass silently if not.

Patched compiler passes tests on x86_64-redhat-linux. With no
complaints I will commit to trunk in the coming days.

---
Fritz Reese

2016-09-14  Fritz Reese  <fritzoreese@gmail.com>

        PR fortran/77584

        * gcc/fortran/decl.c (match_record_decl, gfc_match_decl_type_spec):
        Fixes to handling of structure/record from declaration-type-spec.
        * gcc/testsuite/gfortran.dg/dec_structure_15.f90: New testcase.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 76e00dc..54e765b 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2908,12 +2908,14 @@ done:
 /* Matches a RECORD declaration. */
 
 static match
-match_record_decl (const char *name)
+match_record_decl (char *name)
 {
     locus old_loc;
     old_loc = gfc_current_locus;
+    match m;
 
-    if (gfc_match (" record") == MATCH_YES)
+    m = gfc_match (" record /");
+    if (m == MATCH_YES)
       {
           if (!gfc_option.flag_dec_structure)
             {
@@ -2922,17 +2924,20 @@ match_record_decl (const char *name)
                            "-fdec-structure");
                 return MATCH_ERROR;
             }
-          if (gfc_match (" /%n/", name) != MATCH_YES)
-            {
-                gfc_error ("Structure name expected after RECORD at %C");
-                gfc_current_locus = old_loc;
-                return MATCH_ERROR;
-            }
-          return MATCH_YES;
+          m = gfc_match (" %n/", name);
+          if (m == MATCH_YES)
+            return MATCH_YES;
       }
 
-    gfc_current_locus = old_loc;
+  gfc_current_locus = old_loc;
+  if (gfc_option.flag_dec_structure
+      && (gfc_match (" record% ") == MATCH_YES
+          || gfc_match (" record%t") == MATCH_YES))
+    gfc_error ("Structure name expected after RECORD at %C");
+  if (m == MATCH_NO)
     return MATCH_NO;
+
+  return MATCH_ERROR;
 }
 
 /* Matches a declaration-type-spec (F03:R502).  If successful, sets the ts
@@ -3127,26 +3132,26 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag)
   else
     {
       /* Match nested STRUCTURE declarations; only valid within another
-         structure declaration.  */
-      m = gfc_match (" structure");
-      if (m == MATCH_ERROR)
-        return MATCH_ERROR;
-      else if (m == MATCH_YES)
-        {
-          if (   gfc_current_state () != COMP_STRUCTURE
-              && gfc_current_state () != COMP_MAP)
-              return MATCH_ERROR;
-
-          m = gfc_match_structure_decl ();
-          if (m == MATCH_YES)
-            {
-              /* gfc_new_block is updated by match_structure_decl.  */
-              ts->type = BT_DERIVED;
-              ts->u.derived = gfc_new_block;
-              return MATCH_YES;
-            }
-          return MATCH_ERROR;
-        }
+	 structure declaration.  */
+      if (gfc_option.flag_dec_structure
+	  && (gfc_current_state () == COMP_STRUCTURE
+	      || gfc_current_state () == COMP_MAP))
+	{
+	  m = gfc_match (" structure");
+	  if (m == MATCH_YES)
+	    {
+	      m = gfc_match_structure_decl ();
+	      if (m == MATCH_YES)
+		{
+		  /* gfc_new_block is updated by match_structure_decl.  */
+		  ts->type = BT_DERIVED;
+		  ts->u.derived = gfc_new_block;
+		  return MATCH_YES;
+		}
+	    }
+	  if (m == MATCH_ERROR)
+	    return MATCH_ERROR;
+	}
 
       /* Match CLASS declarations.  */
       m = gfc_match (" class ( * )");
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_15.f90 b/gcc/testsuite/gfortran.dg/dec_structure_15.f90
new file mode 100644
index 0000000..fd06ff9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_15.f90
@@ -0,0 +1,27 @@
+! { dg-do "compile" }
+! { dg-options "" }
+!
+! PR fortran/77584
+! Regression where "structure" and "record" greedily matched a
+! declaration-type-spec in a procedure-declaration-statement (R1212).
+!
+module dec_structure_15
+  abstract interface
+     double precision function structure_()
+     end function structure_
+  end interface
+  abstract interface
+     double precision function record_()
+     end function record_
+  end interface
+contains
+  double precision function a()
+    procedure(structure_), pointer :: b ! regression: Unclassifiable statement
+    a = 0.0
+  end function
+  double precision function a2()
+    procedure(record_), pointer :: b ! regression: Unclassifiable statement
+    a2 = 0.0
+  end function
+end module
+! { dg-final { cleanup-modules "dec_structure_15" } }

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]