Commit 27f31e39 by Mikael Morin Committed by Mikael Morin

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
parent 7cc003b5
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> 2008-11-16 Tobias Burnus <burnus@net-b.de>
PR fortran/38095 PR fortran/38095
......
...@@ -1285,7 +1285,7 @@ typedef struct gfc_namespace ...@@ -1285,7 +1285,7 @@ typedef struct gfc_namespace
this namespace. */ this namespace. */
struct gfc_data *data; struct gfc_data *data;
gfc_charlen *cl_list; gfc_charlen *cl_list, *old_cl_list;
int save_all, seen_save, seen_implicit_none; int save_all, seen_save, seen_implicit_none;
...@@ -2335,6 +2335,7 @@ int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *); ...@@ -2335,6 +2335,7 @@ int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
void gfc_undo_symbols (void); void gfc_undo_symbols (void);
void gfc_commit_symbols (void); void gfc_commit_symbols (void);
void gfc_commit_symbol (gfc_symbol *); void gfc_commit_symbol (gfc_symbol *);
void gfc_free_charlen (gfc_charlen *, gfc_charlen *);
void gfc_free_namespace (gfc_namespace *); void gfc_free_namespace (gfc_namespace *);
void gfc_symbol_init_2 (void); void gfc_symbol_init_2 (void);
......
...@@ -807,6 +807,7 @@ next_statement (void) ...@@ -807,6 +807,7 @@ next_statement (void)
locus old_locus; locus old_locus;
gfc_new_block = NULL; gfc_new_block = NULL;
gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
for (;;) for (;;)
{ {
gfc_statement_label = NULL; gfc_statement_label = NULL;
...@@ -1512,6 +1513,10 @@ accept_statement (gfc_statement st) ...@@ -1512,6 +1513,10 @@ accept_statement (gfc_statement st)
static void static void
reject_statement (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_new_block = NULL;
gfc_undo_symbols (); gfc_undo_symbols ();
gfc_clear_warning (); gfc_clear_warning ();
......
...@@ -3003,6 +3003,24 @@ gfc_free_finalizer_list (gfc_finalizer* list) ...@@ -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 /* Free a namespace structure and everything below it. Interface
lists associated with intrinsic operators are not freed. These are lists associated with intrinsic operators are not freed. These are
taken care of when a specific name is freed. */ taken care of when a specific name is freed. */
...@@ -3010,7 +3028,6 @@ gfc_free_finalizer_list (gfc_finalizer* list) ...@@ -3010,7 +3028,6 @@ gfc_free_finalizer_list (gfc_finalizer* list)
void void
gfc_free_namespace (gfc_namespace *ns) gfc_free_namespace (gfc_namespace *ns)
{ {
gfc_charlen *cl, *cl2;
gfc_namespace *p, *q; gfc_namespace *p, *q;
gfc_intrinsic_op i; gfc_intrinsic_op i;
...@@ -3028,14 +3045,7 @@ gfc_free_namespace (gfc_namespace *ns) ...@@ -3028,14 +3045,7 @@ gfc_free_namespace (gfc_namespace *ns)
free_uop_tree (ns->uop_root); free_uop_tree (ns->uop_root);
free_common_tree (ns->common_root); free_common_tree (ns->common_root);
gfc_free_finalizer_list (ns->finalizers); gfc_free_finalizer_list (ns->finalizers);
gfc_free_charlen (ns->cl_list, NULL);
for (cl = ns->cl_list; cl; cl = cl2)
{
cl2 = cl->next;
gfc_free_expr (cl->length);
gfc_free (cl);
}
free_st_labels (ns->st_labels); free_st_labels (ns->st_labels);
gfc_free_equiv (ns->equiv); gfc_free_equiv (ns->equiv);
......
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> 2008-11-16 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/38097 PR libfortran/38097
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment