From ee0956a19ad1e5f4311f4f72ac0278344436ba82 Mon Sep 17 00:00:00 2001 From: kargl Date: Thu, 28 Dec 2017 20:19:01 +0000 Subject: [PATCH] 2017-12-28 Steven G. Kargl PR Fortran/83548 * match.c (gfc_match_type_spec): Check for LOGICAL conflict in type-spec versus LOGICAL intrinsic subprogram. 2017-12-28 Steven G. Kargl PR Fortran/83548 * gfortran.dg/array_constructor_type_22.f03: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@256022 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 +++++ gcc/fortran/match.c | 30 ++++++++++++---------- gcc/testsuite/ChangeLog | 5 ++++ .../gfortran.dg/array_constructor_type_22.f03 | 29 +++++++++++++++++++++ 4 files changed, 57 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fd4d8a6ae62..678ffc68469 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2017-12-28 Steven G. Kargl + + PR Fortran/83548 + * match.c (gfc_match_type_spec): Check for LOGICAL conflict in + type-spec versus LOGICAL intrinsic subprogram. + 2017-12-28 Janne Blomqvist PR fortran/83344 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index f7de5d501fc..d251a4d8cd8 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -2102,27 +2102,31 @@ gfc_match_type_spec (gfc_typespec *ts) return m; } - if (gfc_match ("logical") == MATCH_YES) - { - ts->type = BT_LOGICAL; - ts->kind = gfc_default_logical_kind; - goto kind_selector; - } - /* REAL is a real pain because it can be a type, intrinsic subprogram, or list item in a type-list of an OpenMP reduction clause. Need to differentiate REAL([KIND]=scalar-int-initialization-expr) from - REAL(A,[KIND]) and REAL(KIND,A). */ + REAL(A,[KIND]) and REAL(KIND,A). Logically, when this code was + written the use of LOGICAL as a type-spec or intrinsic subprogram + was overlooked. */ m = gfc_match (" %n", name); - if (m == MATCH_YES && strcmp (name, "real") == 0) + if (m == MATCH_YES + && (strcmp (name, "real") == 0 || strcmp (name, "logical") == 0)) { char c; gfc_expr *e; locus where; - ts->type = BT_REAL; - ts->kind = gfc_default_real_kind; + if (*name == 'r') + { + ts->type = BT_REAL; + ts->kind = gfc_default_real_kind; + } + else + { + ts->type = BT_LOGICAL; + ts->kind = gfc_default_logical_kind; + } gfc_gobble_whitespace (); @@ -2154,7 +2158,7 @@ gfc_match_type_spec (gfc_typespec *ts) c = gfc_next_char (); if (c == '=') { - if (strcmp(name, "a") == 0) + if (strcmp(name, "a") == 0 || strcmp(name, "l") == 0) return MATCH_NO; else if (strcmp(name, "kind") == 0) goto found; @@ -2194,7 +2198,7 @@ found: gfc_next_char (); /* Burn the ')'. */ ts->kind = (int) mpz_get_si (e->value.integer); - if (gfc_validate_kind (BT_REAL, ts->kind , true) == -1) + if (gfc_validate_kind (ts->type, ts->kind , true) == -1) { gfc_error ("Invalid type-spec at %C"); return MATCH_ERROR; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1e91e7f5480..4be6423aaa2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2017-12-28 Steven G. Kargl + + PR Fortran/83548 + * gfortran.dg/array_constructor_type_22.f03: New test. + 2017-12-28 Janne Blomqvist PR fortran/83344 diff --git a/gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 b/gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 new file mode 100644 index 00000000000..9122eb51e86 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 @@ -0,0 +1,29 @@ +! { dg-do compile } +! PR Fortran/83548 +program foo + + implicit none + + logical, parameter :: t = .true., f = .false. + logical, parameter :: a1(2) = [t, f] + logical(kind=1), parameter :: a2(2) = [logical(kind=1) :: t, f] + logical(kind=4), parameter :: a3(2) = [logical(kind=4) :: t, f] + logical(kind=1), parameter :: a4(2) = [logical(t, 1), logical(f, 1)] + logical(kind=4), parameter :: a5(2) = [logical(t, 4), logical(f, 4)] + logical(kind=1) b(2) + logical(kind=4) c(2) + + real, parameter :: x = 1, y = 2 + real, parameter :: r1(2) = [x, y] + real(kind=4), parameter :: r2(2) = [real(kind=4) :: x, y] + real(kind=8), parameter :: r3(2) = [real(kind=8) :: x, y] + real(kind=4), parameter :: r4(2) = [real(x, 4), real(y, 4)] + real(kind=8), parameter :: r5(2) = [real(x, 8), real(y, 8)] + real(kind=4) p(2) + real(kind=8) q(2) + + p = [real(kind=4) :: x, y] + q = [real(kind=8) :: x, y] + if (any(p .ne. r2)) call abort + if (any(q .ne. r3)) call abort +end program foo -- 2.11.4.GIT