[gcc(refs/users/guojiufu/heads/personal-branch)] Fortran : "type is( real(kind(1.)) )" spurious syntax error PR94397

[Jiu Fu Guo]

https://gcc.gnu.org/g:3ea6977d0f1813d982743a09660eec1760e981ec

commit 3ea6977d0f1813d982743a09660eec1760e981ec
Author: Mark Eggleston <markeggleston@gcc.gnu.org>
Date:   Wed Apr 1 09:52:41 2020 +0100

    Fortran  : "type is( real(kind(1.)) )" spurious syntax error PR94397
    
    Based on a patch in the comments of the PR. That patch fixed this
    problem but caused the test cases for PR93484 to fail. It has been
    changed to reduce initialisation expressions if the expression is
    not EXPR_VARIABLE and not EXPR_CONSTANT.
    
    2020-05-28  Steven G. Kargl  <kargl@gcc.gnu.org>
                Mark Eggleston  <markeggleston@gcc.gnu.org>
    
    gcc/fortran/
    
            PR fortran/94397
            * match.c (gfc_match_type_spec): New variable ok initialised
            to true. Set ok with the return value of gfc_reduce_init_expr
            called only if the expression is not EXPR_CONSTANT and is not
            EXPR_VARIABLE. Add !ok to the check for type not being integer
            or the rank being greater than zero.
    
    2020-05-28  Mark Eggleston  <markeggleston@gcc.gnu.org>
    
    gcc/testsuite/
    
            PR fortran/94397
            * gfortran.dg/pr94397.F90: New test.

Diff:
---
 gcc/fortran/match.c                   |  5 ++++-
 gcc/testsuite/gfortran.dg/pr94397.F90 | 26 ++++++++++++++++++++++++++
 2 files changed, 30 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 8ae34a94a95..82d2b5087e5 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 00000000000..fda10c1a88b
--- /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