diff mbox series

PR Fortran/83548 -- a LOGICAL fix

Message ID 20171225194540.GA89519@troutmask.apl.washington.edu
State New
Headers show
Series PR Fortran/83548 -- a LOGICAL fix | expand

Commit Message

Steve Kargl Dec. 25, 2017, 7:45 p.m. UTC 
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  <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-25  Steven G. Kargl  <kargl@gcc.gnu.org>

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

Comments

Bernhard Reutner-Fischer Dec. 25, 2017, 10:12 p.m. UTC | #1 
On 25 December 2017 20:45:40 CET, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
>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?

+   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

aborts? abort? 

Thanks,
Steve Kargl Dec. 25, 2017, 11:20 p.m. UTC | #2 
On Mon, Dec 25, 2017 at 11:12:49PM +0100, Bernhard Reutner-Fischer wrote:
> On 25 December 2017 20:45:40 CET, Steve Kargl <sgk@troutmask.apl.washington.edu> wrote:
> >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?
> 
> +   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
> 
> aborts? abort? 
> 

Whoops.  Thanks for noticing.  The test is compile-only,
so I missed the typo during testing.
diff mbox series

Patch

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