diff options
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 31 |
1 files changed, 20 insertions, 11 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 7b741b8..7f6bf1b 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -2017,6 +2017,8 @@ check_init_expr_arguments (gfc_expr *e) return MATCH_YES; } +static gfc_try check_restricted (gfc_expr *); + /* F95, 7.1.6.1, Initialization expressions, (7) F2003, 7.1.7 Initialization expression, (8) */ @@ -2096,6 +2098,11 @@ check_inquiry (gfc_expr *e, int not_restricted) } else if (not_restricted && check_init_expr (ap->expr) == FAILURE) return MATCH_ERROR; + + if (not_restricted == 0 + && ap->expr->expr_type != EXPR_VARIABLE + && check_restricted (ap->expr) == FAILURE) + return MATCH_ERROR; } return MATCH_YES; @@ -2421,8 +2428,6 @@ gfc_match_init_expr (gfc_expr **result) } -static gfc_try check_restricted (gfc_expr *); - /* Given an actual argument list, test to see that each argument is a restricted expression and optionally if the expression type is integer or character. */ @@ -2561,14 +2566,17 @@ check_restricted (gfc_expr *e) that host associated dummy array indices are accepted (PR23446). This mechanism also does the same for the specification expressions of array-valued functions. */ - if (sym->attr.in_common - || sym->attr.use_assoc - || sym->attr.dummy - || sym->attr.implied_index - || sym->ns != gfc_current_ns - || (sym->ns->proc_name != NULL - && sym->ns->proc_name->attr.flavor == FL_MODULE) - || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns))) + if (e->error + || sym->attr.in_common + || sym->attr.use_assoc + || sym->attr.dummy + || sym->attr.implied_index + || (sym->ns && sym->ns == gfc_current_ns->parent) + || (sym->ns && gfc_current_ns->parent + && sym->ns == gfc_current_ns->parent->parent) + || (sym->ns->proc_name != NULL + && sym->ns->proc_name->attr.flavor == FL_MODULE) + || (gfc_is_formal_arg () && (sym->ns == gfc_current_ns))) { t = SUCCESS; break; @@ -2576,7 +2584,8 @@ check_restricted (gfc_expr *e) gfc_error ("Variable '%s' cannot appear in the expression at %L", sym->name, &e->where); - + /* Prevent a repetition of the error. */ + e->error = 1; break; case EXPR_NULL: |