Hello, this fixes a case where an unfinished SELECT TYPE statement was leading to an ICE because at the time the statement was rejected, the compiler tried to free some symbols that had already freed with the SELECT TYPE namespace.
The fix moves the namespace allocation and cleanup out of gfc_match_namespace. A syntax error is added to avoid the default "unclassifiable statement" error. Bootstrapped (with asan) and regression tested on x86_64-linux. OK for trunk/4.8? Mikael 2013-04-14 Mikael Morin <mik...@gcc.gnu.org> PR fortran/56816 * match.c (gfc_match_select_type): Add syntax error. Move namespace allocation and cleanup... * parse.c (decode_statement): ... here. 2013-04-14 Mikael Morin <mik...@gcc.gnu.org> PR fortran/56816 * gfortran.dg/select_type_33.f03: New test.
diff --git a/match.c b/match.c index a1529da..b5e9609 100644 --- a/match.c +++ b/match.c @@ -5337,7 +5337,6 @@ gfc_match_select_type (void) char name[GFC_MAX_SYMBOL_LEN]; bool class_array; gfc_symbol *sym; - gfc_namespace *parent_ns; m = gfc_match_label (); if (m == MATCH_ERROR) @@ -5347,8 +5346,6 @@ gfc_match_select_type (void) if (m != MATCH_YES) return m; - gfc_current_ns = gfc_build_block_ns (gfc_current_ns); - m = gfc_match (" %n => %e", name, &expr2); if (m == MATCH_YES) { @@ -5379,7 +5376,10 @@ gfc_match_select_type (void) m = gfc_match (" )%t"); if (m != MATCH_YES) - goto cleanup; + { + gfc_error ("parse error in SELECT TYPE statement at %C"); + goto cleanup; + } /* This ghastly expression seems to be needed to distinguish a CLASS array, which can have a reference, from other expressions that @@ -5417,9 +5417,6 @@ gfc_match_select_type (void) return MATCH_YES; cleanup: - parent_ns = gfc_current_ns->parent; - gfc_free_namespace (gfc_current_ns); - gfc_current_ns = parent_ns; return m; } diff --git a/parse.c b/parse.c index 6dde0c6..74a5b4b 100644 --- a/parse.c +++ b/parse.c @@ -262,6 +262,7 @@ end_of_block: static gfc_statement decode_statement (void) { + gfc_namespace *ns; gfc_statement st; locus old_locus; match m; @@ -363,7 +364,12 @@ decode_statement (void) match (NULL, gfc_match_associate, ST_ASSOCIATE); match (NULL, gfc_match_critical, ST_CRITICAL); match (NULL, gfc_match_select, ST_SELECT_CASE); + + gfc_current_ns = gfc_build_block_ns (gfc_current_ns); match (NULL, gfc_match_select_type, ST_SELECT_TYPE); + ns = gfc_current_ns; + gfc_current_ns = gfc_current_ns->parent; + gfc_free_namespace (ns); /* General statement matching: Instead of testing every possible statement, we eliminate most possibilities by peeking at the
! { dg-do compile } ! ! PR fortran/56816 ! The unfinished SELECT TYPE statement below was leading to an ICE because ! at the time the statement was rejected, the compiler tried to free ! some symbols that had already been freed with the SELECT TYPE ! namespace. ! ! Original testcase from Dominique Pelletier <dominique.pellet...@polymtl.ca> ! module any_list_module implicit none private public :: anylist, anyitem type anylist end type type anyitem class(*), allocatable :: value end type end module any_list_module module my_item_list_module use any_list_module implicit none type, extends (anyitem) :: myitem end type myitem contains subroutine myprint (this) class (myitem) :: this select type ( v => this % value ! { dg-error "parse error in SELECT TYPE" } end select ! { dg-error "Expecting END SUBROUTINE" } end subroutine myprint end module my_item_list_module