From 3ea6977d0f1813d982743a09660eec1760e981ec Mon Sep 17 00:00:00 2001 From: Mark Eggleston Date: Wed, 1 Apr 2020 09:52:41 +0100 Subject: 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 Mark Eggleston 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 gcc/testsuite/ PR fortran/94397 * gfortran.dg/pr94397.F90: New test. --- gcc/fortran/match.c | 5 ++++- gcc/testsuite/gfortran.dg/pr94397.F90 | 26 ++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/pr94397.F90 (limited to 'gcc') diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 8ae34a9..82d2b50 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 0000000..fda10c1 --- /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 -- cgit v1.1