diff options
Diffstat (limited to 'gcc/fortran/expr.c')
-rw-r--r-- | gcc/fortran/expr.c | 83 |
1 files changed, 80 insertions, 3 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 7f6bf1b..5a167b7 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2503,6 +2503,64 @@ restricted_intrinsic (gfc_expr *e) } +/* Check the expressions of an actual arglist. Used by check_restricted. */ + +static gfc_try +check_arglist (gfc_actual_arglist* arg, gfc_try (*checker) (gfc_expr*)) +{ + for (; arg; arg = arg->next) + if (checker (arg->expr) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +/* Check the subscription expressions of a reference chain with a checking + function; used by check_restricted. */ + +static gfc_try +check_references (gfc_ref* ref, gfc_try (*checker) (gfc_expr*)) +{ + int dim; + + if (!ref) + return SUCCESS; + + switch (ref->type) + { + case REF_ARRAY: + for (dim = 0; dim != ref->u.ar.dimen; ++dim) + { + if (checker (ref->u.ar.start[dim]) == FAILURE) + return FAILURE; + if (checker (ref->u.ar.end[dim]) == FAILURE) + return FAILURE; + if (checker (ref->u.ar.stride[dim]) == FAILURE) + return FAILURE; + } + break; + + case REF_COMPONENT: + /* Nothing needed, just proceed to next reference. */ + break; + + case REF_SUBSTRING: + if (checker (ref->u.ss.start) == FAILURE) + return FAILURE; + if (checker (ref->u.ss.end) == FAILURE) + return FAILURE; + break; + + default: + gcc_unreachable (); + break; + } + + return check_references (ref->next, checker); +} + + /* Verify that an expression is a restricted expression. Like its cousin check_init_expr(), an error message is generated if we return FAILURE. */ @@ -2510,7 +2568,7 @@ restricted_intrinsic (gfc_expr *e) static gfc_try check_restricted (gfc_expr *e) { - gfc_symbol *sym; + gfc_symbol* sym; gfc_try t; if (e == NULL) @@ -2526,8 +2584,22 @@ check_restricted (gfc_expr *e) break; case EXPR_FUNCTION: - t = e->value.function.esym ? external_spec_function (e) - : restricted_intrinsic (e); + if (e->value.function.esym) + { + t = check_arglist (e->value.function.actual, &check_restricted); + if (t == SUCCESS) + t = external_spec_function (e); + } + else + { + if (e->value.function.isym && e->value.function.isym->inquiry) + t = SUCCESS; + else + t = check_arglist (e->value.function.actual, &check_restricted); + + if (t == SUCCESS) + t = restricted_intrinsic (e); + } break; case EXPR_VARIABLE: @@ -2561,6 +2633,10 @@ check_restricted (gfc_expr *e) break; } + /* Check reference chain if any. */ + if (check_references (e->ref, &check_restricted) == FAILURE) + break; + /* gfc_is_formal_arg broadcasts that a formal argument list is being processed in resolve.c(resolve_formal_arglist). This is done so that host associated dummy array indices are accepted (PR23446). @@ -2571,6 +2647,7 @@ check_restricted (gfc_expr *e) || sym->attr.use_assoc || sym->attr.dummy || sym->attr.implied_index + || sym->attr.flavor == FL_PARAMETER || (sym->ns && sym->ns == gfc_current_ns->parent) || (sym->ns && gfc_current_ns->parent && sym->ns == gfc_current_ns->parent->parent) |