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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 47b20614cd7643e88380ebfef2768b74617ef82b..b6d97cb3c71f521284cb6ed3ea3145c16beae0a8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+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

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 87a8196906279941fe55eb25e29ea3236a639f5e..f66ed93f9f40620d0558db158077fd5047a167e0 100644 (file)
--- a/gcc/fortran/check.c
+++ b/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;

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 20ecafd944e40a7eca7718104f6b2637f0c9fb73..71539fed448dfe3db341c01fa8d34217bdb489a2 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6c6a077259f54ed914f73a92ad8b35aa37e8cce6..0cf04a5b3a53061f1e6cb4dc3017bf6d9c1578e5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/gnu_logical_2.f90 b/gcc/testsuite/gfortran.dg/gnu_logical_2.f90
index a7b31b4a7e29d8b29f735c9f57f0ed131d879531..0e24c722cc6f167f102371d574a374f51afb8b13 100644 (file)
--- a/gcc/testsuite/gfortran.dg/gnu_logical_2.f90
+++ b/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" }
 

diff --git a/gcc/testsuite/gfortran.dg/pr81509_2.f90 b/gcc/testsuite/gfortran.dg/pr81509_2.f90
index a0618cc49b200f568eac1b7253f6f6af212e11f0..719feb5c5106fbd8bceff29775943ea2d33b2900 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pr81509_2.f90
+++ b/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
 

diff --git a/gcc/testsuite/gfortran.dg/pr92018.f90 b/gcc/testsuite/gfortran.dg/pr92018.f90
new file mode 100644 (file)
index 0000000..6c90d2f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr92018.f90
@@ -0,0 +1,8 @@
+! { 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