Dear All,
This is a rather trivial patch... going on 'obvious' in fact. However,
I must confess to not being entirely sure why the problem is
occurring. Deferred arrays are emanating from the finalizer that are
being presented as ARRAY_TYPES rather than descriptors. What ever is
the reason, the fix is both safe and does what is required.
Bootstrapped and regtested on FC21/x86_64 - OK for trunk?
Paul
2015-12-18 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/68864
* trans-array.c (evaluate_bound): If deferred, test that 'desc'
is an array descriptor before using gfc_conv_descriptor_xxx.
2015-12-18 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/68864
* gfortran.dg/pr68864.f90: New test.
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 231807)
--- gcc/fortran/trans-array.c (working copy)
*************** evaluate_bound (stmtblock_t *block, tree
*** 3821,3830 ****
gfc_add_block_to_block (block, &se.pre);
*output = se.expr;
}
! else if (deferred)
{
/* The gfc_conv_array_lbound () routine returns a constant zero for
! deferred length arrays, which in the scalarizer wrecks havoc, when
copying to a (newly allocated) one-based array.
Keep returning the actual result in sync for both bounds. */
*output = lbound ? gfc_conv_descriptor_lbound_get (desc,
--- 3821,3830 ----
gfc_add_block_to_block (block, &se.pre);
*output = se.expr;
}
! else if (deferred && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
{
/* The gfc_conv_array_lbound () routine returns a constant zero for
! deferred length arrays, which in the scalarizer wreaks havoc, when
copying to a (newly allocated) one-based array.
Keep returning the actual result in sync for both bounds. */
*output = lbound ? gfc_conv_descriptor_lbound_get (desc,
Index: gcc/testsuite/gfortran.dg/pr68864.f90
===================================================================
*** gcc/testsuite/gfortran.dg/pr68864.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/pr68864.f90 (working copy)
***************
*** 0 ****
--- 1,43 ----
+ ! { dg-do run }
+ !
+ ! Contributed by Hossein Talebi <talebi.hoss...@gmail.com>
+ !
+ !
+ Module part_base2_class
+
+ implicit none
+
+ type :: ty_moc1
+ integer l
+ end type ty_moc1
+ integer,parameter :: MAX_NUM_ELEMENT_TYPE=32
+
+ type :: ty_element_index2
+
+ class(ty_moc1),allocatable :: element
+ class(ty_moc1),allocatable :: element_th(:)
+
+ endtype ty_element_index2
+
+ type :: ty_part_base2
+ type(ty_element_index2)::element_index(MAX_NUM_ELEMENT_TYPE)
+ end type ty_part_base2
+
+ class(ty_part_base2),allocatable :: part_tmp_obj
+
+ End Module part_base2_class
+
+ use part_base2_class
+ allocate (part_tmp_obj)
+ allocate (part_tmp_obj%element_index(1)%element, source = ty_moc1(1))
+ allocate (part_tmp_obj%element_index(1)%element_th(1), source =
ty_moc1(99))
+ allocate (part_tmp_obj%element_index(32)%element_th(1), source =
ty_moc1(999))
+
+ do i = 1, MAX_NUM_ELEMENT_TYPE
+ if (allocated (part_tmp_obj%element_index(i)%element_th)) then
+ print *, i, part_tmp_obj%element_index(i)%element_th(1)%l
+ end if
+ end do
+ deallocate (part_tmp_obj)
+
+ end
