Hello world,
the attached patch fixes the regression regarding freeing
namespaces twice.
The test cases where also run unter valgrind without
producing errors.
Regression-tested. OK for trunk?
Thomas
2013-01-27 Thomas Koenig tkoe...@gcc.gnu.org
PR fortran/56054
* decl.c (gfc_match_end): Remove half-ready namespace
from parent if the end of a block is missing.
* parse.c (parse_module): Do not put namespace into
gsymbol on error.
2013-01-27 Thomas Koenig tkoe...@gcc.gnu.org
PR fortran/56054
* gfortran.dg/block_12.f90: New test.
* gfortran.dg/module_error_1.f90: New test.
Index: decl.c
===
--- decl.c (Revision 195319)
+++ decl.c (Arbeitskopie)
@@ -5979,6 +5979,8 @@ gfc_match_end (gfc_statement *st)
const char *target;
int eos_ok;
match m;
+ gfc_namespace *parent_ns, *ns, *prev_ns;
+ gfc_namespace **nsp;
old_loc = gfc_current_locus;
if (gfc_match (end) != MATCH_YES)
@@ -6204,6 +6206,35 @@ syntax:
cleanup:
gfc_current_locus = old_loc;
+
+ /* If we are missing an END BLOCK, we created a half-ready namespace.
+ Remove it from the parent namespace's sibling list. */
+
+ if (state == COMP_BLOCK)
+{
+ parent_ns = gfc_current_ns-parent;
+
+ nsp = (gfc_state_stack-previous-tail-ext.block.ns);
+
+ prev_ns = NULL;
+ ns = *nsp;
+ while (ns)
+ {
+ if (ns == gfc_current_ns)
+ {
+ if (prev_ns == NULL)
+ *nsp = NULL;
+ else
+ prev_ns-sibling = ns-sibling;
+ }
+ prev_ns = ns;
+ ns = ns-sibling;
+ }
+
+ gfc_free_namespace (gfc_current_ns);
+ gfc_current_ns = parent_ns;
+}
+
return MATCH_ERROR;
}
Index: parse.c
===
--- parse.c (Revision 195319)
+++ parse.c (Arbeitskopie)
@@ -4291,6 +4291,7 @@ parse_module (void)
{
gfc_statement st;
gfc_gsymbol *s;
+ bool error;
s = gfc_get_gsymbol (gfc_new_block-name);
if (s-defined || (s-type != GSYM_UNKNOWN s-type != GSYM_MODULE))
@@ -4304,6 +4305,7 @@ parse_module (void)
st = parse_spec (ST_NONE);
+ error = false;
loop:
switch (st)
{
@@ -4322,12 +4324,15 @@ loop:
gfc_error (Unexpected %s statement in MODULE at %C,
gfc_ascii_statement (st));
+ error = true;
reject_statement ();
st = next_statement ();
goto loop;
}
- s-ns = gfc_current_ns;
+ /* Make sure not to free the namespace twice on error. */
+ if (!error)
+s-ns = gfc_current_ns;
}
! { dg-do compile }
module kernels
select type (args) ! { dg-error Unexpected SELECT TYPE }
end module kernels
! { dg-do compile }
! PR 56054 - this used to free a namespace twice.
program main
block
end program main ! { dg-error END BLOCK }
! { dg-prune-output Unexpected end of file }
