aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2021-12-06 23:15:11 +0100
committerHarald Anlauf <anlauf@gmx.de>2021-12-07 18:23:25 +0100
commitf47662204de27f7685699eeef89aa173ccf32d85 (patch)
tree50f62857e6444a803f9fe4c0b379dae5aaf74bf9 /gcc
parent8e836af61b7027c0819da62c12a8d18b7c46f3fc (diff)
downloadgcc-f47662204de27f7685699eeef89aa173ccf32d85.zip
gcc-f47662204de27f7685699eeef89aa173ccf32d85.tar.gz
gcc-f47662204de27f7685699eeef89aa173ccf32d85.tar.bz2
Fortran: add check for type of upper bound in case range
gcc/fortran/ChangeLog: PR fortran/103591 * match.c (match_case_selector): Check type of upper bound in case range. gcc/testsuite/ChangeLog: PR fortran/103591 * gfortran.dg/select_9.f90: New test.
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/match.c9
-rw-r--r--gcc/testsuite/gfortran.dg/select_9.f9010
2 files changed, 19 insertions, 0 deletions
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 2bf2143..52bc5af 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -6075,6 +6075,15 @@ match_case_selector (gfc_case **cp)
m = gfc_match_init_expr (&c->high);
if (m == MATCH_ERROR)
goto cleanup;
+ if (m == MATCH_YES
+ && c->high->ts.type != BT_LOGICAL
+ && c->high->ts.type != BT_INTEGER
+ && c->high->ts.type != BT_CHARACTER)
+ {
+ gfc_error ("Expression in CASE selector at %L cannot be %s",
+ &c->high->where, gfc_typename (c->high));
+ goto cleanup;
+ }
/* MATCH_NO is fine. It's OK if nothing is there! */
}
}
diff --git a/gcc/testsuite/gfortran.dg/select_9.f90 b/gcc/testsuite/gfortran.dg/select_9.f90
new file mode 100644
index 0000000..c580e81
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_9.f90
@@ -0,0 +1,10 @@
+! { dg-do compile }
+! PR fortran/103591 - ICE in gfc_compare_string
+! Contributed by G.Steinmetz
+
+program p
+ integer :: n
+ select case (n)
+ case ('1':2.) ! { dg-error "cannot be REAL" }
+ end select
+end