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 <[email protected]>
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 <[email protected]>
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 <[email protected]>
!
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
