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 <ka...@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 <ka...@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
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
+
