Skip to content

R
riscv-gcc-1
Commit 405e87e8 by Steven G. Kargl
Options

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
parent c988c699
Showing with 155 additions and 43 deletions
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 0 → 100644
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment