diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2018-02-11 18:22:24 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2018-02-11 18:22:24 +0000 |
| commit | e519d2e8199746e9d2b6ef70de55f7331df5bc47 (patch) | |
| tree | bcd2076be4ee7e218ac1d59b0804b3e1d8ccbbac /gcc/fortran | |
| parent | e094c0bfe982c21cd39741efde87591b59af8a55 (diff) | |
| download | gcc-e519d2e8199746e9d2b6ef70de55f7331df5bc47.zip gcc-e519d2e8199746e9d2b6ef70de55f7331df5bc47.tar.gz gcc-e519d2e8199746e9d2b6ef70de55f7331df5bc47.tar.bz2 | |
re PR fortran/84074 (Incorrect indexing of array when actual argument is an array expression and dummy is polymorphic)
2018-02-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84074
* trans-expr.c (gfc_conv_derived_to_class): Set the use_offset
flag. If the is a vector subscript or the expression is not a
variable, make the descriptor one-based.
2018-02-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84074
* gfortran.dg/type_to_class_5.f03: New test.
From-SVN: r257564
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.c | 27 |
2 files changed, 33 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b0bd14f..bebf155 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2018-02-11 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/84074 + * trans-expr.c (gfc_conv_derived_to_class): Set the use_offset + flag. If the is a vector subscript or the expression is not a + variable, make the descriptor one-based. + 2018-02-10 Paul Thomas <pault@gcc.gnu.org> PR fortran/84141 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 7f790e7..a418582 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -547,6 +547,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, tree ctree; tree var; tree tmp; + int dim; /* The derived type needs to be converted to a temporary CLASS object. */ @@ -636,10 +637,34 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, { stmtblock_t block; gfc_init_block (&block); + gfc_ref *ref; parmse->ss = ss; + parmse->use_offset = 1; gfc_conv_expr_descriptor (parmse, e); + /* Detect any array references with vector subscripts. */ + for (ref = e->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY + && ref->u.ar.type != AR_ELEMENT + && ref->u.ar.type != AR_FULL) + { + for (dim = 0; dim < ref->u.ar.dimen; dim++) + if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR) + break; + if (dim < ref->u.ar.dimen) + break; + } + + /* Array references with vector subscripts and non-variable expressions + need be coverted to a one-based descriptor. */ + if (ref || e->expr_type != EXPR_VARIABLE) + { + for (dim = 0; dim < e->rank; ++dim) + gfc_conv_shift_descriptor_lbound (&block, parmse->expr, dim, + gfc_index_one_node); + } + if (e->rank != class_ts.u.derived->components->as->rank) { gcc_assert (class_ts.u.derived->components->as->type @@ -10105,7 +10130,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, &expr1->where, msg); } - /* Deallocate the lhs parameterized components if required. */ + /* Deallocate the lhs parameterized components if required. */ if (dealloc && expr2->expr_type == EXPR_FUNCTION && !expr1->symtree->n.sym->attr.associate_var) { |