diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2ed3e4b04b765f0beadf09a819aef61e36713922..14c226ae137305032d30eeb30c92db0a730a9c53 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2012-01-16 Paul Thomas <pault@gcc.gnu.org>
+
+ * trans-array.c (gfc_trans_create_temp_array): In the case of a
+ class array temporary, detect a null 'eltype' on entry and use
+ 'initial' to provde the class reference and so, through the
+ vtable, the element size for the dynamic type.
+ * trans-stmt.c (gfc_conv_elemental_dependencies): For class
+ expressions, set 'eltype' to null and pass the values via the
+ 'initial' expression.
+
2012-01-14 Tobias Burnus <burnus@net-b.de>
PR fortran/51800
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 57793cee44a262f76f8e6d510ebe67777e39ddc3..6dcd5318a5f8b888d31058feac81c7cb2e4c48dd 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -971,6 +971,11 @@ get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
fields of info if known. Returns the size of the array, or NULL for a
callee allocated array.
+ 'eltype' == NULL signals that the temporary should be a class object.
+ The 'initial' expression is used to obtain the size of the dynamic
+ type; otehrwise the allocation and initialisation proceeds as for any
+ other expression
+
PRE, POST, INITIAL, DYNAMIC and DEALLOC are as for
gfc_trans_allocate_array_storage. */
@@ -990,9 +995,23 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
tree nelem;
tree cond;
tree or_expr;
+ tree class_expr = NULL_TREE;
int n, dim, tmp_dim;
int total_dim = 0;
+ /* This signals a class array for which we need the size of the
+ dynamic type. Generate an eltype and then the class expression. */
+ if (eltype == NULL_TREE && initial)
+ {
+ if (POINTER_TYPE_P (TREE_TYPE (initial)))
+ class_expr = build_fold_indirect_ref_loc (input_location, initial);
+ eltype = TREE_TYPE (class_expr);
+ eltype = gfc_get_element_type (eltype);
+ /* Obtain the structure (class) expression. */
+ class_expr = TREE_OPERAND (class_expr, 0);
+ gcc_assert (class_expr);
+ }
+
memset (from, 0, sizeof (from));
memset (to, 0, sizeof (to));
@@ -1133,16 +1152,21 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
/* Get the size of the array. */
if (size && !callee_alloc)
{
+ tree elemsize;
/* If or_expr is true, then the extent in at least one
dimension is zero and the size is set to zero. */
size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
or_expr, gfc_index_zero_node, size);
nelem = size;
+ if (class_expr == NULL_TREE)
+ elemsize = fold_convert (gfc_array_index_type,
+ TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+ else
+ elemsize = gfc_vtable_size_get (class_expr);
+
size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- size,
- fold_convert (gfc_array_index_type,
- TYPE_SIZE_UNIT (gfc_get_element_type (type))));
+ size, elemsize);
}
else
{
@@ -5083,9 +5107,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
if (expr->ts.type == BT_CLASS && expr3)
{
tmp = build_int_cst (unsigned_char_type_node, 0);
- /* For class objects we need to nullify the memory in case they have
- allocatable components; the reason is that _copy, which is used for
- initialization, first frees the destination. */
+ /* With class objects, it is best to play safe and null the
+ memory because we cannot know if dynamic types have allocatable
+ components or not. */
tmp = build_call_expr_loc (input_location,
builtin_decl_explicit (BUILT_IN_MEMSET),
3, pointer, tmp, size);
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 9456e2d3b059a2cbc400b6009ab718ddeb9d832d..16acc33a2698a8608bcb25d5927fc905723876f2 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -282,19 +282,31 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
|| (fsym->ts.type ==BT_DERIVED
&& fsym->attr.intent == INTENT_OUT))
initial = parmse.expr;
+ /* For class expressions, we always initialize with the copy of
+ the values. */
+ else if (e->ts.type == BT_CLASS)
+ initial = parmse.expr;
else
initial = NULL_TREE;
- /* Find the type of the temporary to create; we don't use the type
- of e itself as this breaks for subcomponent-references in e (where
- the type of e is that of the final reference, but parmse.expr's
- type corresponds to the full derived-type). */
- /* TODO: Fix this somehow so we don't need a temporary of the whole
- array but instead only the components referenced. */
- temptype = TREE_TYPE (parmse.expr); /* Pointer to descriptor. */
- gcc_assert (TREE_CODE (temptype) == POINTER_TYPE);
- temptype = TREE_TYPE (temptype);
- temptype = gfc_get_element_type (temptype);
+ if (e->ts.type != BT_CLASS)
+ {
+ /* Find the type of the temporary to create; we don't use the type
+ of e itself as this breaks for subcomponent-references in e
+ (where the type of e is that of the final reference, but
+ parmse.expr's type corresponds to the full derived-type). */
+ /* TODO: Fix this somehow so we don't need a temporary of the whole
+ array but instead only the components referenced. */
+ temptype = TREE_TYPE (parmse.expr); /* Pointer to descriptor. */
+ gcc_assert (TREE_CODE (temptype) == POINTER_TYPE);
+ temptype = TREE_TYPE (temptype);
+ temptype = gfc_get_element_type (temptype);
+ }
+
+ else
+ /* For class arrays signal that the size of the dynamic type has to
+ be obtained from the vtable, using the 'initial' expression. */
+ temptype = NULL_TREE;
/* Generate the temporary. Cleaning up the temporary should be the
very last thing done, so we add the code to a new block and add it
@@ -312,9 +324,20 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
/* Update other ss' delta. */
gfc_set_delta (loopse->loop);
- /* Copy the result back using unpack. */
- tmp = build_call_expr_loc (input_location,
- gfor_fndecl_in_unpack, 2, parmse.expr, data);
+ /* Copy the result back using unpack..... */
+ if (e->ts.type != BT_CLASS)
+ tmp = build_call_expr_loc (input_location,
+ gfor_fndecl_in_unpack, 2, parmse.expr, data);
+ else
+ {
+ /* ... except for class results where the copy is
+ unconditional. */
+ tmp = build_fold_indirect_ref_loc (input_location, parmse.expr);
+ tmp = gfc_conv_descriptor_data_get (tmp);
+ tmp = build_call_expr_loc (input_location,
+ builtin_decl_explicit (BUILT_IN_MEMCPY),
+ 3, tmp, data, size);
+ }
gfc_add_expr_to_block (&se->post, tmp);
/* parmse.pre is already added above. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 07e452c13bb67ac5ce9bb3f64f98af5871da3bf1..4e58ca5c01865431a53a2ee957c8b0c56c978c3b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-16 Paul Thomas <pault@gcc.gnu.org>
+
+ * gfortran.dg/class_array_3.f03: Remove the explicit loop in
+ subroutine 'qsort' and use index array to assign the result.
+
2012-01-16 Jakub Jelinek <jakub@redhat.com>
PR tree-optimization/51865
diff --git a/gcc/testsuite/gfortran.dg/class_array_3.f03 b/gcc/testsuite/gfortran.dg/class_array_3.f03
index 874fecc357503b909543b0d6f860d02ae9a55b69..8972161fbb3fbec2ea14be1eaeb1bad12e1a65de 100644
--- a/gcc/testsuite/gfortran.dg/class_array_3.f03
+++ b/gcc/testsuite/gfortran.dg/class_array_3.f03
@@ -45,10 +45,7 @@ contains
allocate (tmp(size (a, 1)), source = a)
index_array = [(i, i = 1, size (a, 1))]
call internal_qsort (tmp, index_array) ! Do not move class elements around until end
- do i = 1, size (a, 1) ! Since they can be of arbitrary size.
- a(i) = tmp(index_array(i)) ! Vector index array would be neater
- end do
-! a = tmp(index_array) ! Like this - TODO: fixme
+ a = tmp(index_array)
end subroutine qsort
recursive subroutine internal_qsort (x, iarray)