The attach patch fixes a problem when a LOGICAL subprogram
appears as the first element in an array constructor, which
is interpreted as a LOGICAL type-spec, which fails because
the argument is of type LOGICAL instead of INTEGER.
Regression tested on i686-*-freebsd and x86_64-*-freebsd.
OK to commit?
2017-12-25 Steven G. Kargl <ka...@gcc.gnu.org>
PR Fortran/83548
* match.c (gfc_match_type_spec): Check for LOGICAL conflict in
type-spec versus LOGICAL intrinsic subprogram.
2017-12-25 Steven G. Kargl <ka...@gcc.gnu.org>
PR Fortran/83548
* gfortran.dg/array_constructor_type_22.f03: New test.
--
Steve
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 255997)
+++ gcc/fortran/match.c (working copy)
@@ -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;
Index: gcc/testsuite/gfortran.dg/array_constructor_type_22.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 (nonexistent)
+++ gcc/testsuite/gfortran.dg/array_constructor_type_22.f03 (working copy)
@@ -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 aborts
+end program foo
