diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 8ae34a94a95841ea22c40c2595395b78e2e79625..82d2b5087e5ce7226ae1b050b5c11d6c06b571ea 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2265,7 +2265,10 @@ found:
 	 a scalar integer initialization-expr and valid kind parameter. */
       if (c == ')')
 	{
-	  if (e->ts.type != BT_INTEGER || e->rank > 0)
+	  bool ok = true;
+	  if (e->expr_type != EXPR_CONSTANT && e->expr_type != EXPR_VARIABLE)
+	    ok = gfc_reduce_init_expr (e);
+	  if (!ok || e->ts.type != BT_INTEGER || e->rank > 0)
 	    {
 	      gfc_free_expr (e);
 	      return MATCH_NO;
diff --git a/gcc/testsuite/gfortran.dg/pr94397.F90 b/gcc/testsuite/gfortran.dg/pr94397.F90
new file mode 100644
index 0000000000000000000000000000000000000000..fda10c1a88b85934f3d0676b0ba28c0784a0dff9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr94397.F90
@@ -0,0 +1,26 @@
+! { dg-do run }
+!
+
+module m
+  implicit none
+contains
+  function is_real8(a)
+    class(*) :: a
+    logical :: is_real8
+    is_real8 = .false.
+    select type(a)
+      type is(real(kind(1.0_8)))
+        is_real8 = .true. 
+    end select
+  end function is_real8
+end module m
+
+program test
+  use m
+
+  if (is_real8(1.0_4)) stop 1
+  if (.not. is_real8(1.0_8)) stop 2
+#ifdef __GFC_REAL_16__
+  if (is_real8(1.0_16)) stop 3
+#endif
+end program