diff mbox

[fortran] PR56816: double free on unfinished SELECT TYPE statement

Message ID 516AA66F.4060109@sfr.fr
State New
Headers show

Commit Message

Mikael Morin April 14, 2013, 12:51 p.m. UTC 
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  <mikael@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  <mikael@gcc.gnu.org>

	PR fortran/56816
	* gfortran.dg/select_type_33.f03: New test.
! { 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.pelletier@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

Comments

Thomas Koenig April 14, 2013, 1:03 p.m. UTC | #1 
Hi Mikael,

> Bootstrapped (with asan) and regression tested on x86_64-linux.
> OK for trunk/4.8?

OK for both.

Thanks for the patch!

	Thomas
diff mbox

Patch

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