Allocatable scalar coarrays use an error descriptor...
Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias
2013-04-12 Tobias Burnus <bur...@net-b.de> PR fortran/56929 * trans-array.c (duplicate_allocatable): Fix handling of scalar coarrays. 2013-04-12 Tobias Burnus <bur...@net-b.de> PR fortran/56929 * gfortran.dg/coarray/alloc_comp_2.f90: New. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 05de50d..6cb85d4 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -7321,7 +7321,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, allocate memory to the destination. */ gfc_init_block (&block); - if (rank == 0) + if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest))) { tmp = null_pointer_node; tmp = fold_build2_loc (input_location, MODIFY_EXPR, type, dest, tmp); @@ -7348,7 +7348,11 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, null_data = gfc_finish_block (&block); gfc_init_block (&block); - nelems = get_full_array_size (&block, src, rank); + if (rank) + nelems = get_full_array_size (&block, src, rank); + else + nelems = gfc_index_one_node; + tmp = fold_convert (gfc_array_index_type, TYPE_SIZE_UNIT (gfc_get_element_type (type))); size = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type, @@ -7374,7 +7378,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank, /* Null the destination if the source is null; otherwise do the allocate and copy. */ - if (rank == 0) + if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src))) null_cond = src; else null_cond = gfc_conv_descriptor_data_get (src); --- /dev/null 2013-04-12 09:16:45.096038934 +0200 +++ gcc/gcc/testsuite/gfortran.dg/coarray/alloc_comp_2.f90 2013-04-12 17:36:48.867633882 +0200 @@ -0,0 +1,19 @@ +! { dg-do compile } +! +! PR fortran/56929 +! +! Contributed by Damian Rouson +! +! Allocatable scalar corrays were mishandled (ICE) +! +module parent_coarray_component + type parent + real, allocatable :: dummy[:] + end type + type, extends(parent) :: child + end type +contains + subroutine do_something(this) + class(child) this + end +end