[gcc r12-5825] Fortran: add check for type of upper bound in case range

[gcc r12-5825] Fortran: add check for type of upper bound in case range

[Harald Anlauf]

https://gcc.gnu.org/g:f47662204de27f7685699eeef89aa173ccf32d85

commit r12-5825-gf47662204de27f7685699eeef89aa173ccf32d85
Author: Harald Anlauf <anlauf@gmx.de>
Date:   Mon Dec 6 23:15:11 2021 +0100

    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.

Diff:
---
 gcc/fortran/match.c                    |  9 +++++++++
 gcc/testsuite/gfortran.dg/select_9.f90 | 10 ++++++++++
 2 files changed, 19 insertions(+)

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 2bf21434a42..52bc5af7542 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 00000000000..c580e8162bd
--- /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