re PR fortran/83548 (Compilation Error using logical function in parameter)

2017-12-28  Steven G. Kargl  <kargl@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-28  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR Fortran/83548
	* gfortran.dg/array_constructor_type_22.f03: New test.

From-SVN: r256022

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fd4d8a6ae62b00cccd1e0e5e9c0f5dfad6b7ab2f..678ffc684694560ce485e43f9954ea5b3a6a120a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2017-12-28  Steven G. Kargl  <kargl@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-28  Janne Blomqvist  <jb@gcc.gnu.org>
 
        PR fortran/83344

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index f7de5d501fc348e42614ecadceaf00b86225af17..d251a4d8cd8a41810d8cec468fd96240d9278b3d 100644 (file)
--- 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 1e91e7f5480ccc6ec5d20fdb463bd9a121fcf4ba..4be6423aaa2622172b904411163a8d494ea71b5e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-12-28  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR Fortran/83548
+       * gfortran.dg/array_constructor_type_22.f03: New test.
+
 2017-12-28  Janne Blomqvist  <jb@gcc.gnu.org>
 
        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 (file)
index 0000000..9122eb5
--- /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