diff options
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 87 |
1 files changed, 52 insertions, 35 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 6ef4eb864e6..8a23374a6c9 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1784,8 +1784,14 @@ simplify_const_ref (gfc_expr *p) string_len = 0; if (!p->ts.u.cl) - p->ts.u.cl = gfc_new_charlen (p->symtree->n.sym->ns, - NULL); + { + if (p->symtree) + p->ts.u.cl = gfc_new_charlen (p->symtree->n.sym->ns, + NULL); + else + p->ts.u.cl = gfc_new_charlen (gfc_current_ns, + NULL); + } else gfc_free_expr (p->ts.u.cl->length); @@ -2390,6 +2396,8 @@ check_inquiry (gfc_expr *e, int not_restricted) int i = 0; gfc_actual_arglist *ap; + gfc_symbol *sym; + gfc_symbol *asym; if (!e->value.function.isym || !e->value.function.isym->inquiry) @@ -2399,20 +2407,22 @@ check_inquiry (gfc_expr *e, int not_restricted) if (e->symtree == NULL) return MATCH_NO; - if (e->symtree->n.sym->from_intmod) + sym = e->symtree->n.sym; + + if (sym->from_intmod) { - if (e->symtree->n.sym->from_intmod == INTMOD_ISO_FORTRAN_ENV - && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS - && e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION) + if (sym->from_intmod == INTMOD_ISO_FORTRAN_ENV + && sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS + && sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION) return MATCH_NO; - if (e->symtree->n.sym->from_intmod == INTMOD_ISO_C_BINDING - && e->symtree->n.sym->intmod_sym_id != ISOCBINDING_C_SIZEOF) + if (sym->from_intmod == INTMOD_ISO_C_BINDING + && sym->intmod_sym_id != ISOCBINDING_C_SIZEOF) return MATCH_NO; } else { - name = e->symtree->n.sym->name; + name = sym->name; functions = (gfc_option.warn_std & GFC_STD_F2003) ? inquiry_func_f2003 : inquiry_func_f95; @@ -2434,41 +2444,48 @@ check_inquiry (gfc_expr *e, int not_restricted) if (!ap->expr) continue; + asym = ap->expr->symtree ? ap->expr->symtree->n.sym : NULL; + if (ap->expr->ts.type == BT_UNKNOWN) { - if (ap->expr->symtree->n.sym->ts.type == BT_UNKNOWN - && !gfc_set_default_type (ap->expr->symtree->n.sym, 0, gfc_current_ns)) + if (asym && asym->ts.type == BT_UNKNOWN + && !gfc_set_default_type (asym, 0, gfc_current_ns)) return MATCH_NO; - ap->expr->ts = ap->expr->symtree->n.sym->ts; + ap->expr->ts = asym->ts; } - /* Assumed character length will not reduce to a constant expression - with LEN, as required by the standard. */ - if (i == 5 && not_restricted && ap->expr->symtree - && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER - && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL - || ap->expr->symtree->n.sym->ts.deferred)) - { - gfc_error ("Assumed or deferred character length variable %qs " - "in constant expression at %L", - ap->expr->symtree->n.sym->name, - &ap->expr->where); - return MATCH_ERROR; - } - else if (not_restricted && !gfc_check_init_expr (ap->expr)) - return MATCH_ERROR; + if (asym && asym->assoc && asym->assoc->target + && asym->assoc->target->expr_type == EXPR_CONSTANT) + { + gfc_free_expr (ap->expr); + ap->expr = gfc_copy_expr (asym->assoc->target); + } - if (not_restricted == 0 - && ap->expr->expr_type != EXPR_VARIABLE - && !check_restricted (ap->expr)) + /* Assumed character length will not reduce to a constant expression + with LEN, as required by the standard. */ + if (i == 5 && not_restricted && asym + && asym->ts.type == BT_CHARACTER + && ((asym->ts.u.cl && asym->ts.u.cl->length == NULL) + || asym->ts.deferred)) + { + gfc_error ("Assumed or deferred character length variable %qs " + "in constant expression at %L", + asym->name, &ap->expr->where); return MATCH_ERROR; + } + else if (not_restricted && !gfc_check_init_expr (ap->expr)) + return MATCH_ERROR; + + if (not_restricted == 0 + && ap->expr->expr_type != EXPR_VARIABLE + && !check_restricted (ap->expr)) + return MATCH_ERROR; - if (not_restricted == 0 - && ap->expr->expr_type == EXPR_VARIABLE - && ap->expr->symtree->n.sym->attr.dummy - && ap->expr->symtree->n.sym->attr.optional) - return MATCH_NO; + if (not_restricted == 0 + && ap->expr->expr_type == EXPR_VARIABLE + && asym->attr.dummy && asym->attr.optional) + return MATCH_NO; } return MATCH_YES; |