Hi Mikael,
On 9/11/23 14:38, Mikael Morin via Gcc-patches wrote:
Hello,
this fixes a memory management issue in the fortran frontend.
I have included the (reduced) testcase from the PR, even if it wasn't failing
here on x86_64 with the test harness.
Tested on x86_64-pc-linux-gnu and manually checked the testcase with
valgrind.
OK for master?
nice fix! This is OK for mainline.
Thanks for the patch!
Harald
-- >8 --
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.
---
gcc/fortran/gfortran.h | 2 +-
gcc/fortran/symbol.cc | 57 ++++++++++++++++++++------
gcc/testsuite/gfortran.dg/pr110996.f90 | 16 ++++++++
3 files changed, 62 insertions(+), 13 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr110996.f90
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 371f8743312..f4a1c106cea 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 2cba2ea0bed..a6078bc608a 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);
+ bool freed = delete_symbol_from_ns (p, p->ns);
- gfc_release_symbol (p);
+ /* 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 00000000000..0e7551059a3
--- /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.benn...@embecosm.com>
+
+PROGRAM p
+CONTAINS
+ SUBROUTINE c(d) e { dg-error "Syntax error" }
+ SUBROUTINE f
+ END
+END