diff options
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 42 |
1 files changed, 31 insertions, 11 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index 8fa46d8..d846c0f 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -1154,8 +1154,13 @@ remove_subobject_ref (gfc_expr *p, gfc_constructor *cons) { gfc_expr *e; - e = cons->expr; - cons->expr = NULL; + if (cons) + { + e = cons->expr; + cons->expr = NULL; + } + else + e = gfc_copy_expr (p); e->ref = p->ref->next; p->ref->next = NULL; gfc_replace_expr (p, e); @@ -1464,6 +1469,7 @@ simplify_const_ref (gfc_expr *p) { gfc_constructor *cons; gfc_expr *newp; + gfc_ref *last_ref; while (p->ref) { @@ -1473,6 +1479,13 @@ simplify_const_ref (gfc_expr *p) switch (p->ref->u.ar.type) { case AR_ELEMENT: + /* <type/kind spec>, parameter :: x(<int>) = scalar_expr + will generate this. */ + if (p->expr_type != EXPR_ARRAY) + { + remove_subobject_ref (p, NULL); + break; + } if (find_array_element (p->value.constructor, &p->ref->u.ar, &cons) == FAILURE) return FAILURE; @@ -1502,18 +1515,25 @@ simplify_const_ref (gfc_expr *p) return FAILURE; } - /* If this is a CHARACTER array and we possibly took a - substring out of it, update the type-spec's character - length according to the first element (as all should have - the same length). */ - if (p->ts.type == BT_CHARACTER) + if (p->ts.type == BT_DERIVED + && p->ref->next + && p->value.constructor) { - int string_len; + /* There may have been component references. */ + p->ts = p->value.constructor->expr->ts; + } - gcc_assert (p->ref->next); - gcc_assert (!p->ref->next->next); - gcc_assert (p->ref->next->type == REF_SUBSTRING); + last_ref = p->ref; + for (; last_ref->next; last_ref = last_ref->next) {}; + if (p->ts.type == BT_CHARACTER + && last_ref->type == REF_SUBSTRING) + { + /* If this is a CHARACTER array and we possibly took + a substring out of it, update the type-spec's + character length according to the first element + (as all should have the same length). */ + int string_len; if (p->value.constructor) { const gfc_expr* first = p->value.constructor->expr; |