From: Steven G. Kargl <kargl@gcc.gnu.org>
Date: Mon, 8 Jun 2015 15:55:16 +0000 (+0000)
Subject: re PR fortran/66245 (ICE on select type with empty type spec)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ef701bbe50402a6b44f73bc3913ac8c85b1d5b9e;p=gcc.git

re PR fortran/66245 (ICE on select type with empty type spec)

2015-06-08  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/66245
	* match.c (gfc_match_type_is, gfc_match_class_is):  Check if the
	return type spec or derived type spec is validate.

2015-06-08  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/66245
	* gfortran.dg/class_is_1.f90: New test.
	* gfortran.dg/type_is_1.f90: Ditto.

From-SVN: r224237
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7d3e31e0a02..cf42e384e07 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2015-06-08  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/66245
+	* match.c (gfc_match_type_is, gfc_match_class_is):  Check if the
+	return type spec or derived type spec is validate.
+
 2015-06-06  Thomas Koenig  <tkoenig@netcologne.de>
 
 	PR fortran/47659
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index b51d18a2925..c064135bcab 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5456,7 +5456,10 @@ gfc_match_type_is (void)
   c = gfc_get_case ();
   c->where = gfc_current_locus;
 
-  if (gfc_match_type_spec (&c->ts) == MATCH_ERROR)
+  m = gfc_match_type_spec (&c->ts);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
     goto cleanup;
 
   if (gfc_match_char (')') != MATCH_YES)
@@ -5536,7 +5539,10 @@ gfc_match_class_is (void)
   c = gfc_get_case ();
   c->where = gfc_current_locus;
 
-  if (match_derived_type_spec (&c->ts) == MATCH_ERROR)
+  m = match_derived_type_spec (&c->ts);
+  if (m == MATCH_NO)
+    goto syntax;
+  if (m == MATCH_ERROR)
     goto cleanup;
 
   if (c->ts.type == BT_DERIVED)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 202551f2161..ffef82e3ff2 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2015-06-08  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/66245
+	* gfortran.dg/class_is_1.f90: New test.
+	* gfortran.dg/type_is_1.f90: Ditto.
+
 2015-06-08  Marek Polacek  <polacek@redhat.com>
 
 	PR c/66415
diff --git a/gcc/testsuite/gfortran.dg/class_is_1.f90 b/gcc/testsuite/gfortran.dg/class_is_1.f90
new file mode 100644
index 00000000000..b5bc5a99c8d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_is_1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! PR fortran/66245
+! Original testcase by Gerhard Steinmetz
+! <gerhard dot steinmetz dot fortran at t-online dot de>
+program p
+   type t; end type
+   class(t), allocatable :: x
+   call s
+   contains
+      subroutine s
+         select type ( x )
+         class is ( )       ! { dg-error "error in CLASS IS" }
+         end select
+      end subroutine s
+end program p
diff --git a/gcc/testsuite/gfortran.dg/type_is_1.f90 b/gcc/testsuite/gfortran.dg/type_is_1.f90
new file mode 100644
index 00000000000..860a668240a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/type_is_1.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! PR fortran/66245
+! Original testcase by Gerhard Steinmetz
+! <gerhard dot steinmetz dot fortran at t-online dot de>
+program p
+   type t; end type
+   class(t), allocatable :: x
+   call s
+   contains
+      subroutine s
+         select type ( x )
+         type is ( )       ! { dg-error "error in TYPE IS" }
+         end select
+      end subroutine s
+end program p