aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/expr.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/expr.c')
-rw-r--r--gcc/fortran/expr.c83
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)