[gcc r14-3864] fortran: Undo new symbols in all namespaces [PR110996]

[gcc r14-3864] fortran: Undo new symbols in all namespaces [PR110996]

[Mikael Morin]

https://gcc.gnu.org/g:b9cbd1a2c2f50d4e305938d97916011bd5839ce0

commit r14-3864-gb9cbd1a2c2f50d4e305938d97916011bd5839ce0
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Tue Sep 12 10:24:20 2023 +0200

    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:
---
 gcc/fortran/gfortran.h                 |  2 +-
 gcc/fortran/symbol.cc                  | 59 ++++++++++++++++++++++++++--------
 gcc/testsuite/gfortran.dg/pr110996.f90 | 16 +++++++++
 3 files changed, 63 insertions(+), 14 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 371f8743312a..f4a1c106cea1 100644
--- 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 2cba2ea0bed7..a6078bc608af 100644
--- 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
index 000000000000..0e7551059a30
--- /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