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

gcc/fortran/ChangeLog

+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

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;

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/array_constructor_type_22.f03

+! { 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