re PR fortran/37992 (ICE while resolving charlen for rejected statements)

2008-11-16  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/37992
	* gfortran.h (gfc_namespace): Added member old_cl_list,
	backup of cl_list.
	(gfc_free_charlen): Added prototype.
	* symbol.c (gfc_free_charlen): New function.
	(gfc_free_namespace): Use gfc_free_charlen.
	* parse.c (next_statement): Backup gfc_current_ns->cl_list.
	(reject_statement): Restore gfc_current_ns->cl_list.
	Free cl_list's elements before dropping them.

2008-11-16  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/37992
	* gfotran.dg/charlen_free_1.f90: New test.

From-SVN: r141927

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ceb2f7c00e09fdf2ad16852a3026bf6d4438599f..a72820cc8a32aac8d035513fe406813e66fec19c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2008-11-16  Mikael Morin  <mikael.morin@tele2.fr>
+
+       PR fortran/37992
+       * gfortran.h (gfc_namespace): Added member old_cl_list, 
+       backup of cl_list.
+       (gfc_free_charlen): Added prototype.
+       * symbol.c (gfc_free_charlen): New function.
+       (gfc_free_namespace): Use gfc_free_charlen.
+       * parse.c (next_statement): Backup gfc_current_ns->cl_list.
+       (reject_statement): Restore gfc_current_ns->cl_list.
+       Free cl_list's elements before dropping them.
+
 2008-11-16  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/38095

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 174e9af042c44e39bf5d38a63493609cb58de6a7..ac68a52dd3d42482e9d5a57b8ddf037b2a1c7cb3 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1285,7 +1285,7 @@ typedef struct gfc_namespace
      this namespace.  */
   struct gfc_data *data;
 
-  gfc_charlen *cl_list;
+  gfc_charlen *cl_list, *old_cl_list;
 
   int save_all, seen_save, seen_implicit_none;
 
@@ -2335,6 +2335,7 @@ int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
 void gfc_undo_symbols (void);
 void gfc_commit_symbols (void);
 void gfc_commit_symbol (gfc_symbol *);
+void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
 void gfc_free_namespace (gfc_namespace *);
 
 void gfc_symbol_init_2 (void);

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index e52c06f0a5a699a9aa4fe745e0c977e3727df12a..954a22f092643f915108c4d93165f0990b4e1905 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -807,6 +807,7 @@ next_statement (void)
   locus old_locus;
   gfc_new_block = NULL;
 
+  gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
   for (;;)
     {
       gfc_statement_label = NULL;
@@ -1512,6 +1513,10 @@ accept_statement (gfc_statement st)
 static void
 reject_statement (void)
 {
+  /* Revert to the previous charlen chain.  */
+  gfc_free_charlen (gfc_current_ns->cl_list, gfc_current_ns->old_cl_list);
+  gfc_current_ns->cl_list = gfc_current_ns->old_cl_list;
+
   gfc_new_block = NULL;
   gfc_undo_symbols ();
   gfc_clear_warning ();

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index bf66ac8986b824c7358a5d4fca22c83850b304c0..ac953bde6bb264a0456d9e2f68b0b44cc96d802d 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3003,6 +3003,24 @@ gfc_free_finalizer_list (gfc_finalizer* list)
 }
 
 
+/* Free the charlen list from cl to end (end is not freed). 
+   Free the whole list if end is NULL.  */
+
+void gfc_free_charlen (gfc_charlen *cl, gfc_charlen *end)
+{
+  gfc_charlen *cl2;
+
+  for (; cl != end; cl = cl2)
+    {
+      gcc_assert (cl);
+
+      cl2 = cl->next;
+      gfc_free_expr (cl->length);
+      gfc_free (cl);
+    }
+}
+
+
 /* Free a namespace structure and everything below it.  Interface
    lists associated with intrinsic operators are not freed.  These are
    taken care of when a specific name is freed.  */
@@ -3010,7 +3028,6 @@ gfc_free_finalizer_list (gfc_finalizer* list)
 void
 gfc_free_namespace (gfc_namespace *ns)
 {
-  gfc_charlen *cl, *cl2;
   gfc_namespace *p, *q;
   gfc_intrinsic_op i;
 
@@ -3028,14 +3045,7 @@ gfc_free_namespace (gfc_namespace *ns)
   free_uop_tree (ns->uop_root);
   free_common_tree (ns->common_root);
   gfc_free_finalizer_list (ns->finalizers);
-
-  for (cl = ns->cl_list; cl; cl = cl2)
-    {
-      cl2 = cl->next;
-      gfc_free_expr (cl->length);
-      gfc_free (cl);
-    }
-
+  gfc_free_charlen (ns->cl_list, NULL);
   free_st_labels (ns->st_labels);
 
   gfc_free_equiv (ns->equiv);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 632216dac0b49fb02bda5083089e4b32dda34d41..daa937c0463ee9c6b2d39a4dcdbe3a7eefe9fd10 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-11-16  Mikael Morin  <mikael.morin@tele2.fr>
+
+       PR fortran/37992
+       * gfotran.dg/charlen_free_1.f90: New test.
+
 2008-11-16  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/38097