re PR fortran/92018 (ICE in gfc_conv_constant_to_tree, at fortran/trans-const.c:370)

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

	PR 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
 	un-on errors.
	* resolve.c (resolve_function): Actual arguments cannot be BOZ in
	a function reference.

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

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

From-SVN: r276898

gcc/fortran/ChangeLog

 2019-10-11  Steven G. Kargl  <kargl@gcc.gnu.org>
 
+	PR 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-11  Steven G. Kargl  <kargl@gcc.gnu.org>
+
 	PR fortran/92019
 	* array.c (match_subscript): BOZ cannot be an array subscript.
 

gcc/fortran/check.c

@@ -34,6 +34,24 @@ along with GCC; see the file COPYING3.  If not see
 #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 +81,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 +98,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 +2420,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 +2434,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,20 +2701,32 @@ gfc_check_dshift (gfc_expr *i, gfc_expr *j, gfc_expr *shift)
   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 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 (!type_check (i, 0, BT_INTEGER))
-    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 (!type_check (j, 1, BT_INTEGER))
+  /* 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 (!same_type_check (i, 0, j, 1))
@@ -2860,7 +2899,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 +6168,11 @@ gfc_check_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size)
   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 +7332,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;

gcc/fortran/resolve.c

@@ -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;

gcc/testsuite/ChangeLog

 2019-10-11  Steven G. Kargl  <kargl@gcc.gnu.org>
 
+	PR fortran/92018
+	* gfortran.dg/gnu_logical_2.f90: Update dg-error regex.
+	* gfortran.dg/pr81509_2.f90: Ditto.
+	* gfortran.dg/pr92018.f90: New test.
+
+2019-10-11  Steven G. Kargl  <kargl@gcc.gnu.org>
+
 	PR fortran/92019
 	* gfortran.dg/pr92019.f90: New test.
 

gcc/testsuite/gfortran.dg/gnu_logical_2.f90

@@ -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" }
 

gcc/testsuite/gfortran.dg/pr81509_2.f90

@@ -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
 

gcc/testsuite/gfortran.dg/pr92018.f90

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