aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/trans-array.c15
-rw-r--r--gcc/fortran/trans-expr.c3
-rw-r--r--gcc/fortran/trans-stmt.c1
-rw-r--r--gcc/fortran/trans.c23
4 files changed, 39 insertions, 3 deletions
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6566c47..998d4d4 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3787,7 +3787,20 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
decl = sym->backend_decl;
}
else if (sym->ts.type == BT_CLASS)
- decl = NULL_TREE;
+ {
+ if (UNLIMITED_POLY (sym))
+ {
+ gfc_expr *class_expr = gfc_find_and_cut_at_last_class_ref (expr);
+ gfc_init_se (&tmpse, NULL);
+ gfc_conv_expr (&tmpse, class_expr);
+ if (!se->class_vptr)
+ se->class_vptr = gfc_class_vptr_get (tmpse.expr);
+ gfc_free_expr (class_expr);
+ decl = tmpse.expr;
+ }
+ else
+ decl = NULL_TREE;
+ }
se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
}
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index a690839..2c31ec9 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -728,7 +728,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_expr *len;
gfc_se se;
- len = gfc_copy_expr (e);
+ len = gfc_find_and_cut_at_last_class_ref (e);
gfc_add_len_component (len);
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, len);
@@ -739,6 +739,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
integer_zero_node));
else
tmp = se.expr;
+ gfc_free_expr (len);
}
else
tmp = integer_zero_node;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 389fec7..adc6b8f 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -2091,6 +2091,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
/* Obtain a temporary class container for the result. */
gfc_conv_derived_to_class (&se, e, sym->ts, tmp, false, false);
se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
+ need_len_assign = false;
}
else
{
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ed05426..8caa625 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -429,7 +429,28 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
/* If decl or vptr are non-null, pointer arithmetic for the array reference
is likely. Generate the 'span' for the array reference. */
if (vptr)
- span = gfc_vptr_size_get (vptr);
+ {
+ span = gfc_vptr_size_get (vptr);
+
+ /* Check if this is an unlimited polymorphic object carrying a character
+ payload. In this case, the 'len' field is non-zero. */
+ if (decl && GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
+ {
+ tmp = gfc_class_len_or_zero_get (decl);
+ if (!integer_zerop (tmp))
+ {
+ tree cond;
+ tree stype = TREE_TYPE (span);
+ tmp = fold_convert (stype, tmp);
+ cond = fold_build2_loc (input_location, EQ_EXPR,
+ logical_type_node, tmp,
+ build_int_cst (stype, 0));
+ tmp = fold_build2 (MULT_EXPR, stype, span, tmp);
+ span = fold_build3_loc (input_location, COND_EXPR, stype,
+ cond, span, tmp);
+ }
+ }
+ }
else if (decl)
span = get_array_span (type, decl);