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

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

[Harald Anlauf]

https://gcc.gnu.org/g:423e0a98e3d972fb180803665a8c02b017b72d15

commit r11-9366-g423e0a98e3d972fb180803665a8c02b017b72d15
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.
    
    (cherry picked from commit f47662204de27f7685699eeef89aa173ccf32d85)

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 bccc85df87a..74d03d062b3 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -6092,6 +6092,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