diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bef16a52624..47be01fd0a9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2013-02-02 Thomas Koenig + + PR fortran/50627 + 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. + 2012-01-30 Tobias Burnus PR fortran/56138 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2a6342c681c..72c511c8b24 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -5955,6 +5955,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) @@ -6180,6 +6182,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; } diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 94d204c6178..6ee7b7fb85c 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 50798c77841..c7657437324 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2013-02-02 Thomas Koenig + + PR fortran/50627 + PR fortran/56054 + * gfortran.dg/block_12.f90: New test. + * gfortran.dg/module_error_1.f90: New test. + 2013-02-02 Richard Sandiford * lib/target-supports.exp (check_effective_target_vect_float) diff --git a/gcc/testsuite/gfortran.dg/block_12.f90 b/gcc/testsuite/gfortran.dg/block_12.f90 new file mode 100644 index 00000000000..a7e9c104390 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/block_12.f90 @@ -0,0 +1,6 @@ +! { dg-do compile } +! PR 50627 - this used to free a namespace twice. +program main + block +end program main ! { dg-error "END BLOCK" } +! { dg-prune-output "Unexpected end of file" } diff --git a/gcc/testsuite/gfortran.dg/module_error_1.f90 b/gcc/testsuite/gfortran.dg/module_error_1.f90 new file mode 100644 index 00000000000..84decc0a571 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/module_error_1.f90 @@ -0,0 +1,5 @@ +! { dg-do compile } +! PR fortran/50627 +module kernels + select type (args) ! { dg-error "Unexpected SELECT TYPE" } +end module kernels