This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] PR fortran/66245 -- Check [derived] type spec
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Fri, 5 Jun 2015 16:55:33 -0700
- Subject: [PATCH] PR fortran/66245 -- Check [derived] type spec
- Authentication-results: sourceware.org; auth=none
The attached patch checks that TYPE IS and CLASS IS
return a type spec or a derived type spec. Regression
tested without any new failures. OK to commit?
2015-06-05 Steven G. Kargl <kargl@gcc.gnu.org>
* match.c (gfc_match_type_is, gfc_match_class_is): Check if the
return type spec or derived type spec is validate.
2015-06-05 Steven G. Kargl <kargl@gcc.gnu.org>
* gfortran.dg/class_is_1.f90: New test.
* gfortran.dg/type_is_1.f90: Ditto.
--
Steve
Index: fortran/match.c
===================================================================
--- fortran/match.c (revision 224174)
+++ fortran/match.c (working copy)
@@ -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)
Index: testsuite/gfortran.dg/class_is_1.f90
===================================================================
--- testsuite/gfortran.dg/class_is_1.f90 (revision 0)
+++ testsuite/gfortran.dg/class_is_1.f90 (working copy)
@@ -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
Index: testsuite/gfortran.dg/type_is_1.f90
===================================================================
--- testsuite/gfortran.dg/type_is_1.f90 (revision 0)
+++ testsuite/gfortran.dg/type_is_1.f90 (working copy)
@@ -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