re PR fortran/25252 (ICE on invalid code)

	PR fortran/25252

	* interface.c (gfc_current_interface_head,
	gfc_set_current_interface_head): New functions.
	* decl.c (gfc_match_modproc): Move check for syntax error earlier.
	On syntax error, restore previous state of the interface.
	* gfortran.h (gfc_current_interface_head,
	gfc_set_current_interface_head): New prototypes.

	* gfortran.dg/interface_22.f90: New test.

From-SVN: r130259

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ad4a9f9..4ed0421 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,15 @@
 2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
+       PR fortran/25252
+       * interface.c (gfc_current_interface_head,
+       gfc_set_current_interface_head): New functions.
+       * decl.c (gfc_match_modproc): Move check for syntax error earlier.
+       On syntax error, restore previous state of the interface.
+       * gfortran.h (gfc_current_interface_head,
+       gfc_set_current_interface_head): New prototypes.
+
+2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
        PR fortran/30285
        * module.c (struct written_common, written_commons): New structure.
        (compare_written_commons, free_written_common, write_common_0):

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index be197bc..325d012 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5837,6 +5837,7 @@ gfc_match_modproc (void)
   gfc_symbol *sym;
   match m;
   gfc_namespace *module_ns;
+  gfc_interface *old_interface_head, *interface;
 
   if (gfc_state_stack->state != COMP_INTERFACE
       || gfc_state_stack->previous == NULL
@@ -5856,14 +5857,29 @@ gfc_match_modproc (void)
   if (module_ns == NULL)
     return MATCH_ERROR;
 
+  /* Store the current state of the interface. We will need it if we
+     end up with a syntax error and need to recover.  */
+  old_interface_head = gfc_current_interface_head ();
+
   for (;;)
     {
+      bool last = false;
+
       m = gfc_match_name (name);
       if (m == MATCH_NO)
        goto syntax;
       if (m != MATCH_YES)
        return MATCH_ERROR;
 
+      /* Check for syntax error before starting to add symbols to the
+        current namespace.  */
+      if (gfc_match_eos () == MATCH_YES)
+       last = true;
+      if (!last && gfc_match_char (',') != MATCH_YES)
+       goto syntax;
+
+      /* Now we're sure the syntax is valid, we process this item
+        further.  */
       if (gfc_get_symbol (name, module_ns, &sym))
        return MATCH_ERROR;
 
@@ -5877,15 +5893,26 @@ gfc_match_modproc (void)
 
       sym->attr.mod_proc = 1;
 
-      if (gfc_match_eos () == MATCH_YES)
+      if (last)
        break;
-      if (gfc_match_char (',') != MATCH_YES)
-       goto syntax;
     }
 
   return MATCH_YES;
 
 syntax:
+  /* Restore the previous state of the interface.  */
+  interface = gfc_current_interface_head ();
+  gfc_set_current_interface_head (old_interface_head);
+
+  /* Free the new interfaces.  */
+  while (interface != old_interface_head)
+  {
+    gfc_interface *i = interface->next;
+    gfc_free (interface);
+    interface = i;
+  }
+
+  /* And issue a syntax error.  */
   gfc_syntax_error (ST_MODULE_PROC);
   return MATCH_ERROR;
 }

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 39fd3a1..cc6ad98 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2308,6 +2308,8 @@ try gfc_extend_expr (gfc_expr *);
 void gfc_free_formal_arglist (gfc_formal_arglist *);
 try gfc_extend_assign (gfc_code *, gfc_namespace *);
 try gfc_add_interface (gfc_symbol *);
+gfc_interface *gfc_current_interface_head (void);
+void gfc_set_current_interface_head (gfc_interface *);
 
 /* io.c */
 extern gfc_st_label format_asterisk;

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 650cd21..67a60f6 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2707,6 +2707,52 @@ gfc_add_interface (gfc_symbol *new)
 }
 
 
+gfc_interface *
+gfc_current_interface_head (void)
+{
+  switch (current_interface.type)
+    {
+      case INTERFACE_INTRINSIC_OP:
+       return current_interface.ns->operator[current_interface.op];
+       break;
+
+      case INTERFACE_GENERIC:
+       return current_interface.sym->generic;
+       break;
+
+      case INTERFACE_USER_OP:
+       return current_interface.uop->operator;
+       break;
+
+      default:
+       gcc_unreachable ();
+    }
+}
+
+
+void
+gfc_set_current_interface_head (gfc_interface *i)
+{
+  switch (current_interface.type)
+    {
+      case INTERFACE_INTRINSIC_OP:
+       current_interface.ns->operator[current_interface.op] = i;
+       break;
+
+      case INTERFACE_GENERIC:
+       current_interface.sym->generic = i;
+       break;
+
+      case INTERFACE_USER_OP:
+       current_interface.uop->operator = i;
+       break;
+
+      default:
+       gcc_unreachable ();
+    }
+}
+
+
 /* Gets rid of a formal argument list.  We do not free symbols.
    Symbols are freed when a namespace is freed.  */
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1386ceb..8fce122 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2007-11-17  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
+
+       PR fortran/25252
+       * interface.c (gfc_current_interface_head,
+       gfc_set_current_interface_head): New functions.
+       * decl.c (gfc_match_modproc): Move check for syntax error earlier.
+       On syntax error, restore previous state of the interface.
+       * gfortran.h (gfc_current_interface_head,
+       gfc_set_current_interface_head): New prototypes.
+
 2007-11-17  Richard Guenther  <rguenther@suse.de>
 
        PR middle-end/34130

diff --git a/gcc/testsuite/gfortran.dg/interface_22.f90 b/gcc/testsuite/gfortran.dg/interface_22.f90
new file mode 100644 (file)
index 0000000..6228fc9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_22.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! This is a check for error recovery: we used to ICE in various places, or
+! emit bogus error messages (PR 25252)
+!
+module foo
+  interface bar
+    module procedure X, Y, ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
+  end interface bar
+end module
+
+module g
+  interface i
+    module procedure sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
+  end interface i
+end module g
+
+module gswap
+  type points
+    real :: x, y
+  end type points
+  interface swap
+    module procedure sreal, schar, sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
+  end interface swap
+end module gswap