PR fortran/92018 -- BOZ the gift that keeps giving
diff mbox series

Message ID 20191008231416.GA4477@troutmask.apl.washington.edu
State New
Headers show
Series
  • PR fortran/92018 -- BOZ the gift that keeps giving
Related show

Commit Message

Steve Kargl Oct. 8, 2019, 11:14 p.m. UTC
Tested on x86_64-*-freebsd.  OK to commit?

A BOZ literal constant can be an actual argument in a
very limited number of intrinsic subprograms.  For those
intrinsics subprograms, the BOZ literal constant is converted
either during checking (see check.c) or simplification 
(see simplify.c).  In resolve.c (resolve_function), I added
code that would walk the actual argument list to check for a
BOZ, but that code was restricted to functions with the EXTERNAL
attribute.

The new testcase, pr92018.f90, demonstrates a situation 
when neither the INTRINSIC and EXTERNAL attribute is set,
and the actual argument list contains BOZ.  This led to
an ICE.  The patch removes the previous restriction, and
so the actual arguments for all functions are checked.
This works except it pointed to a deficiency in the checking
routines.  If something was rejected, (e.g., IAND(Z'12',Z34')),
the BOZ were passed onto resolve_function() and run-on errors
were reported.  To avoid these additional error messages, I have
added the reset_boz() function, which converts a rejected
BOZ to a default integer kind 0.

2019-10-09  Steven G. Kargl  <kargl@gcc.gnu.org>

	PF fortran/92018
	* check.c (reset_boz): New function.
	(illegal_boz_arg, boz_args_check, gfc_check_complex, gfc_check_float,
	gfc_check_transfer): Use it.
	(gfc_check_dshift): Use reset_boz, and re-arrange the checking to
	help suppress possible run-on errors.
	(gfc_check_and): Restore checks for valid argument types.  Use
	reset_boz, and re-arrange the checking to help suppress possible
	run-on errors.
	* resolve.c (resolve_function): Actual arguments cannot be BOZ in
	a function reference.

2019-10-09  Steven G. Kargl  <kargl@gcc.gnu.org>

	PF fortran/92018
	* gfortran.dg/gnu_logical_2.f90: Update dg-error regex.
	* gfortran.dg/pr81509_2.f90: Ditto.
	* gfortran.dg/pr92018.f90: New test.

Comments

Janne Blomqvist Oct. 11, 2019, 2:53 p.m. UTC | #1
On Wed, Oct 9, 2019 at 2:14 AM Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
>
> Tested on x86_64-*-freebsd.  OK to commit?
>
> A BOZ literal constant can be an actual argument in a
> very limited number of intrinsic subprograms.  For those
> intrinsics subprograms, the BOZ literal constant is converted
> either during checking (see check.c) or simplification
> (see simplify.c).  In resolve.c (resolve_function), I added
> code that would walk the actual argument list to check for a
> BOZ, but that code was restricted to functions with the EXTERNAL
> attribute.
>
> The new testcase, pr92018.f90, demonstrates a situation
> when neither the INTRINSIC and EXTERNAL attribute is set,
> and the actual argument list contains BOZ.  This led to
> an ICE.  The patch removes the previous restriction, and
> so the actual arguments for all functions are checked.
> This works except it pointed to a deficiency in the checking
> routines.  If something was rejected, (e.g., IAND(Z'12',Z34')),
> the BOZ were passed onto resolve_function() and run-on errors
> were reported.  To avoid these additional error messages, I have
> added the reset_boz() function, which converts a rejected
> BOZ to a default integer kind 0.
>
> 2019-10-09  Steven G. Kargl  <kargl@gcc.gnu.org>
>
>         PF fortran/92018
>         * check.c (reset_boz): New function.
>         (illegal_boz_arg, boz_args_check, gfc_check_complex, gfc_check_float,
>         gfc_check_transfer): Use it.
>         (gfc_check_dshift): Use reset_boz, and re-arrange the checking to
>         help suppress possible run-on errors.
>         (gfc_check_and): Restore checks for valid argument types.  Use
>         reset_boz, and re-arrange the checking to help suppress possible
>         run-on errors.
>         * resolve.c (resolve_function): Actual arguments cannot be BOZ in
>         a function reference.
>
> 2019-10-09  Steven G. Kargl  <kargl@gcc.gnu.org>
>
>         PF fortran/92018
>         * gfortran.dg/gnu_logical_2.f90: Update dg-error regex.
>         * gfortran.dg/pr81509_2.f90: Ditto.
>         * gfortran.dg/pr92018.f90: New test.
>
> --
> Steve

Ok.

Patch
diff mbox series

Index: gcc/fortran/check.c
===================================================================
--- gcc/fortran/check.c	(revision 276705)
+++ gcc/fortran/check.c	(working copy)
@@ -30,10 +30,29 @@  along with GCC; see the file COPYING3.  If not see
 #include "coretypes.h"
 #include "options.h"
 #include "gfortran.h"
+#include "arith.h"
 #include "intrinsic.h"
 #include "constructor.h"
 #include "target-memory.h"
 
+
+/* Reset a BOZ to a zero value.  This is used to prevent run-on errors
+   from resolve.c(resolve_function).  */
+
+static void
+reset_boz (gfc_expr *x)
+{
+  /* Clear boz info.  */
+  x->boz.rdx = 0;
+  x->boz.len = 0;
+  free (x->boz.str);
+
+  x->ts.type = BT_INTEGER;
+  x->ts.kind = gfc_default_integer_kind;
+  mpz_init (x->value.integer);
+  mpz_set_ui (x->value.integer, 0);
+}
+
 /* A BOZ literal constant can appear in a limited number of contexts.
    gfc_invalid_boz() is a helper function to simplify error/warning
    generation.  gfortran accepts the nonstandard 'X' for 'Z', and gfortran
@@ -63,6 +82,7 @@  illegal_boz_arg (gfc_expr *x)
     {
       gfc_error ("BOZ literal constant at %L cannot be an actual argument "
 		 "to %qs", &x->where, gfc_current_intrinsic);
+      reset_boz (x);
       return true;
     }
 
@@ -79,6 +99,8 @@  boz_args_check(gfc_expr *i, gfc_expr *j)
       gfc_error ("Arguments of %qs at %L and %L cannot both be BOZ "
 		 "literal constants", gfc_current_intrinsic, &i->where,
 		 &j->where);
+      reset_boz (i);
+      reset_boz (j);
       return false;
 
     }
@@ -2399,7 +2421,10 @@  gfc_check_complex (gfc_expr *x, gfc_expr *y)
     {
       if (gfc_invalid_boz ("BOZ constant at %L cannot appear in the COMPLEX "
 			   "intrinsic subprogram", &x->where))
-	return false;
+	{
+	  reset_boz (x);
+	  return false;
+        }
       if (y->ts.type == BT_INTEGER && !gfc_boz2int (x, y->ts.kind))
 	return false;
       if (y->ts.type == BT_REAL && !gfc_boz2real (x, y->ts.kind))
@@ -2410,7 +2435,10 @@  gfc_check_complex (gfc_expr *x, gfc_expr *y)
     {
       if (gfc_invalid_boz ("BOZ constant at %L cannot appear in the COMPLEX "
 			   "intrinsic subprogram", &y->where))
-	return false;
+	{
+	  reset_boz (y);
+	  return false;
+	}
       if (x->ts.type == BT_INTEGER && !gfc_boz2int (y, x->ts.kind))
 	return false;
       if (x->ts.type == BT_REAL && !gfc_boz2real (y, x->ts.kind))
@@ -2674,22 +2702,34 @@  gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *
   if (!boz_args_check (i, j))
     return false;
 
-  /* If i is BOZ and j is integer, convert i to type of j.  */
-  if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
-      && !gfc_boz2int (i, j->ts.kind))
-    return false;
+  /* If i is BOZ and j is integer, convert i to type of j.  If j is not
+     an integer, clear the BOZ; otherwise, check that i is an integer.  */
+  if (i->ts.type == BT_BOZ)
+    {
+      if (j->ts.type != BT_INTEGER)
+        reset_boz (i);
+      else if (!gfc_boz2int (i, j->ts.kind))
+	return false;
+    }
+  else if (!type_check (i, 0, BT_INTEGER))
+    {
+      if (j->ts.type == BT_BOZ)
+	reset_boz (j);
+      return false;
+    }
 
-  /* If j is BOZ and i is integer, convert j to type of i.  */
-  if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
-      && !gfc_boz2int (j, i->ts.kind))
+  /* If j is BOZ and i is integer, convert j to type of i.  If i is not
+     an integer, clear the BOZ; otherwise, check that i is an integer.  */
+  if (j->ts.type == BT_BOZ)
+    {
+      if (i->ts.type != BT_INTEGER)
+        reset_boz (j);
+      else if (!gfc_boz2int (j, i->ts.kind))
+	return false;
+    }
+  else if (!type_check (j, 1, BT_INTEGER))
     return false;
 
-  if (!type_check (i, 0, BT_INTEGER))
-    return false;
-
-  if (!type_check (j, 1, BT_INTEGER))
-    return false;
-
   if (!same_type_check (i, 0, j, 1))
     return false;
 
@@ -2860,7 +2900,10 @@  gfc_check_float (gfc_expr *a)
     {
       if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in the "
 			   "FLOAT intrinsic subprogram", &a->where))
-	return false;
+	{
+	  reset_boz (a);
+	  return false;
+	}
       if (!gfc_boz2int (a, gfc_default_integer_kind))
 	return false;
     }
@@ -6126,7 +6169,11 @@  gfc_check_transfer (gfc_expr *source, gfc_expr *mold, 
   if (size != NULL)
     {
       if (!type_check (size, 2, BT_INTEGER))
-	return false;
+	{
+	  if (size->ts.type == BT_BOZ)
+	    reset_boz (size);
+	  return false;
+	}
 
       if (!scalar_check (size, 2))
 	return false;
@@ -7286,19 +7333,61 @@  gfc_check_system_sub (gfc_expr *cmd, gfc_expr *status)
 bool
 gfc_check_and (gfc_expr *i, gfc_expr *j)
 {
+  if (i->ts.type != BT_INTEGER
+      && i->ts.type != BT_LOGICAL
+      && i->ts.type != BT_BOZ)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER, "
+                 "LOGICAL, or a BOZ literal constant",
+		 gfc_current_intrinsic_arg[0]->name,
+                 gfc_current_intrinsic, &i->where);
+      return false;
+    }
+
+  if (j->ts.type != BT_INTEGER
+      && j->ts.type != BT_LOGICAL
+      && j->ts.type != BT_BOZ)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER, "
+                 "LOGICAL, or a BOZ literal constant",
+		 gfc_current_intrinsic_arg[1]->name,
+                 gfc_current_intrinsic, &j->where);
+      return false;
+    }
+
   /* i and j cannot both be BOZ literal constants.  */
   if (!boz_args_check (i, j))
     return false;
 
   /* If i is BOZ and j is integer, convert i to type of j.  */
-  if (i->ts.type == BT_BOZ && j->ts.type == BT_INTEGER
-      && !gfc_boz2int (i, j->ts.kind))
-    return false;
+  if (i->ts.type == BT_BOZ)
+    {
+      if (j->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER",
+		     gfc_current_intrinsic_arg[1]->name,
+		     gfc_current_intrinsic, &j->where);
+	  reset_boz (i);
+	  return false;
+	}
+      if (!gfc_boz2int (i, j->ts.kind))
+	return false;
+    }
 
   /* If j is BOZ and i is integer, convert j to type of i.  */
-  if (j->ts.type == BT_BOZ && i->ts.type == BT_INTEGER
-      && !gfc_boz2int (j, i->ts.kind))
-    return false;
+  if (j->ts.type == BT_BOZ)
+    {
+      if (i->ts.type != BT_INTEGER)
+	{
+	  gfc_error ("%qs argument of %qs intrinsic at %L must be INTEGER",
+		     gfc_current_intrinsic_arg[0]->name,
+		     gfc_current_intrinsic, &j->where);
+	  reset_boz (j);
+	  return false;
+	}
+      if (!gfc_boz2int (j, i->ts.kind))
+	return false;
+    }
 
   if (!same_type_check (i, 0, j, 1, false))
     return false;
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 276705)
+++ gcc/fortran/resolve.c	(working copy)
@@ -3243,19 +3243,14 @@  resolve_function (gfc_expr *expr)
     return t;
 
   /* Walk the argument list looking for invalid BOZ.  */
-  if (expr->value.function.esym)
-    {
-      gfc_actual_arglist *a;
-
-      for (a = expr->value.function.actual; a; a = a->next)
-	if (a->expr && a->expr->ts.type == BT_BOZ)
-	  {
-	    gfc_error ("A BOZ literal constant at %L cannot appear as an "
-			"actual argument in a function reference",
-			&a->expr->where);
-	    return false;
-	  }
-    }
+  for (arg = expr->value.function.actual; arg; arg = arg->next)
+    if (arg->expr && arg->expr->ts.type == BT_BOZ)
+      {
+	gfc_error ("A BOZ literal constant at %L cannot appear as an "
+		   "actual argument in a function reference",
+		   &arg->expr->where);
+	return false;
+      }
 
   temp = need_full_assumed_size;
   need_full_assumed_size = 0;
Index: gcc/testsuite/gfortran.dg/gnu_logical_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/gnu_logical_2.f90	(revision 276705)
+++ gcc/testsuite/gfortran.dg/gnu_logical_2.f90	(working copy)
@@ -7,22 +7,22 @@ 
 
   print *, and(i,i)
   print *, and(l,l)
-  print *, and(i,r) ! { dg-error "must be the same type" }
-  print *, and(c,l) ! { dg-error "must be the same type" }
+  print *, and(i,r) ! { dg-error "must be INTEGER, LOGICAL, or a BOZ" }
+  print *, and(c,l) ! { dg-error "must be INTEGER, LOGICAL, or a BOZ" }
   print *, and(i,l) ! { dg-error "must be the same type" }
   print *, and(l,i) ! { dg-error "must be the same type" }
 
   print *, or(i,i)
   print *, or(l,l)
-  print *, or(i,r) ! { dg-error "must be the same type" }
-  print *, or(c,l) ! { dg-error "must be the same type" }
+  print *, or(i,r) ! { dg-error "must be INTEGER, LOGICAL, or a BOZ" }
+  print *, or(c,l) ! { dg-error "must be INTEGER, LOGICAL, or a BOZ" }
   print *, or(i,l) ! { dg-error "must be the same type" }
   print *, or(l,i) ! { dg-error "must be the same type" }
 
   print *, xor(i,i)
   print *, xor(l,l)
-  print *, xor(i,r) ! { dg-error "must be the same type" }
-  print *, xor(c,l) ! { dg-error "must be the same type" }
+  print *, xor(i,r) ! { dg-error "must be INTEGER, LOGICAL, or a BOZ" }
+  print *, xor(c,l) ! { dg-error "must be INTEGER, LOGICAL, or a BOZ" }
   print *, xor(i,l) ! { dg-error "must be the same type" }
   print *, xor(l,i) ! { dg-error "must be the same type" }
 
Index: gcc/testsuite/gfortran.dg/pr81509_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr81509_2.f90	(revision 276705)
+++ gcc/testsuite/gfortran.dg/pr81509_2.f90	(working copy)
@@ -13,6 +13,6 @@  k = ieor(z'ade',i)
 k = ior(i,z'1111')
 k = ior(i,k)                  ! { dg-error "different kind type parameters" }
 k = and(i,k)                  ! { dg-error "must be the same type" }
-k = and(a,z'1234')            ! { dg-error "must be the same type" }
+k = and(a,z'1234')            ! { dg-error "must be INTEGER" }
 end program foo
 
Index: gcc/testsuite/gfortran.dg/pr92018.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr92018.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr92018.f90	(working copy)
@@ -0,0 +1,9 @@ 
+! { dg-do compile }
+! PR fortran/92018
+subroutine sub (f)
+   integer :: f
+   print *, f(b'11') ! { dg-error "cannot appear as an actual" }
+   print *, f(o'11') ! { dg-error "cannot appear as an actual" }
+   print *, f(z'11') ! { dg-error "cannot appear as an actual" }
+end
+