From a5e5226441e3bf95c0e0a4f4db6d687c9215229c Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Sun, 14 Apr 2013 17:50:57 +0000 Subject: [PATCH] re PR fortran/56816 (ICE in delete_root) fortran/ PR fortran/56816 * match.c (gfc_match_select_type): Add syntax error. Move namespace allocation and cleanup... * parse.c (decode_statement): ... here. testsuite/ PR fortran/56816 * gfortran.dg/select_type_33.f03: New test. From-SVN: r197950 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/match.c | 11 ++--- gcc/fortran/parse.c | 6 +++ gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/select_type_33.f03 | 43 ++++++++++++++++++++ 5 files changed, 65 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/select_type_33.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8f88b0b0042..2b1f82a831d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2013-04-14 Mikael Morin + + PR fortran/56816 + * match.c (gfc_match_select_type): Add syntax error. Move namespace + allocation and cleanup... + * parse.c (decode_statement): ... here. + 2013-04-13 Janus Weil PR fortran/55959 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index a1529da51c5..b5e9609d965 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/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/gcc/fortran/parse.c b/gcc/fortran/parse.c index 6dde0c651b5..74a5b4b6c40 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/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 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 28b9b62bd2e..cdff281c930 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2013-04-14 Mikael Morin + + PR fortran/56816 + * gfortran.dg/select_type_33.f03: New test. + 2013-04-13 Janus Weil PR fortran/55959 diff --git a/gcc/testsuite/gfortran.dg/select_type_33.f03 b/gcc/testsuite/gfortran.dg/select_type_33.f03 new file mode 100644 index 00000000000..3ba27e0103c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/select_type_33.f03 @@ -0,0 +1,43 @@ +! { 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 +! +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