The attach patch add checking for a valid type during
matching of a CASE selector. Built and regression
tested on i386-*-freebsd. OK to commit?
2015-11-01 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/68151
* match.c (match_case_selector): Check for invalid type.
2015-11-01 Steven G. Kargl <ka...@gcc.gnu.org>
PR fortran/68151
* gfortran.dg/pr68151.f90: New test.
--
Steve
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 229634)
+++ gcc/fortran/match.c (working copy)
@@ -5036,6 +5036,15 @@ match_case_selector (gfc_case **cp)
goto need_expr;
if (m == MATCH_ERROR)
goto cleanup;
+
+ /* F08:C830 case-expr shall be of type character, integer, or logical. */
+ if (c->high->ts.type != BT_LOGICAL && c->high->ts.type != BT_INTEGER
+ && c->high->ts.type != BT_CHARACTER)
+ {
+ gfc_error ("Expression in CASE at %L cannot be %s",
+ &c->high->where, gfc_typename (&c->high->ts));
+ goto cleanup;
+ }
}
else
{
@@ -5045,6 +5054,15 @@ match_case_selector (gfc_case **cp)
if (m == MATCH_NO)
goto need_expr;
+ /* F08:C830 case-expr shall be of type character, integer, or logical. */
+ if (c->low->ts.type != BT_LOGICAL && c->low->ts.type != BT_INTEGER
+ && c->low->ts.type != BT_CHARACTER)
+ {
+ gfc_error ("Expression in CASE at %L cannot be %s",
+ &c->low->where, gfc_typename (&c->low->ts));
+ goto cleanup;
+ }
+
/* If we're not looking at a ':' now, make a range out of a single
target. Else get the upper bound for the case range. */
if (gfc_match_char (':') != MATCH_YES)
Index: gcc/testsuite/gfortran.dg/pr68151.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr68151.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/pr68151.f90 (working copy)
@@ -0,0 +1,13 @@
+! { dg-do compile }
+! PR fortran/68151
+! Original code contribute by Gerhard Steinmetz
+! <gerhard dot steinmetz dot fortran at t-online dot de>
+!
+program p
+ integer :: k = 1
+ select case (k)
+ case (:huge(1._4)) ! { dg-error "Expression in CASE" }
+ case (:huge(2._8)) ! { dg-error "Expression in CASE" }
+ case ((1.0,2.0)) ! { dg-error "Expression in CASE" }
+ end select
+end
