fortran: Undo new symbols in all namespaces [PR110996]

Remove new symbols from all namespaces they may have been added to in case a
statement mismatches in the end and all the symbols referenced in it have to
be reverted.

This fixes memory errors and random internal compiler errors caused by
a new symbol left with dangling pointers but not properly removed from the
namespace at statement rejection.

Before this change, new symbols were removed from their own namespace
(their ns field) only.  This change additionally removes them from the
namespaces pointed to by respectively the gfc_current_ns global variable,
and the symbols' formal_ns field.

	PR fortran/110996

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_release_symbol): Set return type to bool.
	* symbol.cc (gfc_release_symbol): Ditto.  Return whether symbol was
	freed.
	(delete_symbol_from_ns): New, outline code from...
	(gfc_restore_last_undo_checkpoint): ... here.  Delete new symbols
	from two more namespaces.

gcc/testsuite/ChangeLog:

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

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 371f8743312ac8b1be3f0b44c1d1739c9aea3692..f4a1c106cea1dff1fcf4cd216f99849fc1265341 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3514,7 +3514,7 @@ gfc_symtree *gfc_get_unique_symtree (gfc_namespace *);
 gfc_user_op *gfc_get_uop (const char *);
 gfc_user_op *gfc_find_uop (const char *, gfc_namespace *);
 void gfc_free_symbol (gfc_symbol *&);
-void gfc_release_symbol (gfc_symbol *&);
+bool gfc_release_symbol (gfc_symbol *&);
 gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *);
 gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *);
 int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);

diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 2cba2ea0bed7543e3a3f55d9917b6cf10b978a5e..a6078bc608af16fc2f6c50fc7352bb8dc0574ad9 100644 (file)
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -3105,13 +3105,14 @@ gfc_free_symbol (gfc_symbol *&sym)
 }
 
 
-/* Decrease the reference counter and free memory when we reach zero.  */
+/* Decrease the reference counter and free memory when we reach zero.
+   Returns true if the symbol has been freed, false otherwise.  */
 
-void
+bool
 gfc_release_symbol (gfc_symbol *&sym)
 {
   if (sym == NULL)
-    return;
+    return false;
 
   if (sym->formal_ns != NULL && sym->refs == 2 && sym->formal_ns != sym->ns
       && (!sym->attr.entry || !sym->module))
@@ -3125,10 +3126,11 @@ gfc_release_symbol (gfc_symbol *&sym)
 
   sym->refs--;
   if (sym->refs > 0)
-    return;
+    return false;
 
   gcc_assert (sym->refs == 0);
   gfc_free_symbol (sym);
+  return true;
 }
 
 
@@ -3649,6 +3651,29 @@ gfc_drop_last_undo_checkpoint (void)
 }
 
 
+/* Remove the reference to the symbol SYM in the symbol tree held by NS
+   and free SYM if the last reference to it has been removed.
+   Returns whether the symbol has been freed.  */
+
+static bool
+delete_symbol_from_ns (gfc_symbol *sym, gfc_namespace *ns)
+{
+  if (ns == nullptr)
+    return false;
+
+  /* The derived type is saved in the symtree with the first
+     letter capitalized; the all lower-case version to the
+     derived type contains its associated generic function.  */
+  const char *sym_name = gfc_fl_struct (sym->attr.flavor)
+                        ? gfc_dt_upper_string (sym->name)
+                        : sym->name;
+
+  gfc_delete_symtree (&ns->sym_root, sym_name);
+
+  return gfc_release_symbol (sym);
+}
+
+
 /* Undoes all the changes made to symbols since the previous checkpoint.
    This subroutine is made simpler due to the fact that attributes are
    never removed once added.  */
@@ -3703,15 +3728,23 @@ gfc_restore_last_undo_checkpoint (void)
        }
       if (p->gfc_new)
        {
-         /* The derived type is saved in the symtree with the first
-            letter capitalized; the all lower-case version to the
-            derived type contains its associated generic function.  */
-         if (gfc_fl_struct (p->attr.flavor))
-           gfc_delete_symtree (&p->ns->sym_root,gfc_dt_upper_string (p->name));
-          else
-           gfc_delete_symtree (&p->ns->sym_root, p->name);
-
-         gfc_release_symbol (p);
+         bool freed = delete_symbol_from_ns (p, p->ns);
+
+         /* If the symbol is a procedure (function or subroutine), remove
+            it from the procedure body namespace as well as from the outer
+            namespace.  */
+         if (!freed
+             && p->formal_ns != p->ns)
+           freed = delete_symbol_from_ns (p, p->formal_ns);
+
+         /* If the formal_ns field has not been set yet, the previous
+            conditional does nothing.  In that case, we can assume that
+            gfc_current_ns is the procedure body namespace, and remove the
+            symbol from there.  */
+         if (!freed
+             && gfc_current_ns != p->ns
+             && gfc_current_ns != p->formal_ns)
+           freed = delete_symbol_from_ns (p, gfc_current_ns);
        }
       else
        restore_old_symbol (p);

diff --git a/gcc/testsuite/gfortran.dg/pr110996.f90 b/gcc/testsuite/gfortran.dg/pr110996.f90
new file mode 100644 (file)
index 0000000..0e75510
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr110996.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+!
+! PR fortran/110996
+! This example used to result in memory errors and sometimes internal compiler
+! errors, because the rejection of the subroutine statement was causing the
+! symbol D to be freed without also freeing the symbol C which remained in the
+! namespace with a dangling pointer to D.
+!
+! Original testcase from Jeremy Bennett  <jeremy.bennett@embecosm.com>
+
+PROGRAM p
+CONTAINS
+  SUBROUTINE c(d) e { dg-error "Syntax error" }
+  SUBROUTINE f
+  END
+END