diff options
-rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/fortran/trans-array.c | 36 | ||||
-rw-r--r-- | gcc/fortran/trans-stmt.c | 49 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/class_array_3.f03 | 5 |
5 files changed, 82 insertions, 23 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2ed3e4b..14c226a 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 57793ce..6dcd531 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 9456e2d..16acc33 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 07e452c..4e58ca5 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 874fecc..8972161 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) |