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

4 files changed, 38 insertions, 10 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ceb2f7c..a72820c 100644
--- 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 174e9af..ac68a52 100644
--- 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 e52c06f..954a22f 100644
--- 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 bf66ac8..ac953bd 100644
--- 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);