diff options
author | Steven G. Kargl <kargl@gcc.gnu.org> | 2019-10-11 17:52:27 +0000 |
---|---|---|
committer | Steven G. Kargl <kargl@gcc.gnu.org> | 2019-10-11 17:52:27 +0000 |
commit | 405e87e8259b6e70bdf31544bb0e5d147e6f301a (patch) | |
tree | 391bc2773fd2595ed167845cf3a458678e069741 /gcc/fortran | |
parent | c988c699fa09c91485afa24526f965e3fd4269d6 (diff) | |
download | gcc-405e87e8259b6e70bdf31544bb0e5d147e6f301a.zip gcc-405e87e8259b6e70bdf31544bb0e5d147e6f301a.tar.gz gcc-405e87e8259b6e70bdf31544bb0e5d147e6f301a.tar.bz2 |
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
Diffstat (limited to 'gcc/fortran')
-rw-r--r-- | gcc/fortran/ChangeLog | 14 | ||||
-rw-r--r-- | gcc/fortran/check.c | 134 | ||||
-rw-r--r-- | gcc/fortran/resolve.c | 21 |
3 files changed, 133 insertions, 36 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 47b2061..b6d97cb3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,19 @@ 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. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 87a8196..f66ed93 100644 --- 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 20ecafd..71539fe 100644 --- 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; |