I am worried that this fix seems to easy by half and so I am posting
it for approval, rather than committing it as obvious. I would be
obliged if somebody would test it thoroughly.
Bootstraps and regtests on FC23/x86_64 - OK for trunk and 7 branch?
Paul
2018-27-01 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/56691
* trans-array.c (gfc_conv_expr_descriptor): If the source array
is a descriptor type, use its offset, removing the condition
that is be a class expression.
2018-27-01 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/56691
* gfortran.dg/type_to_class_4.f03: New test.
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 257065)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_expr_descriptor (gfc_se *se, gf
*** 7529,7537 ****
: base;
gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp);
}
! else if (IS_CLASS_ARRAY (expr) && !se->data_not_needed
! && (!rank_remap || se->use_offset)
! && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
{
gfc_conv_descriptor_offset_set (&loop.pre, parm,
gfc_conv_descriptor_offset_get (desc));
--- 7529,7537 ----
: base;
gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp);
}
! else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
! && !se->data_not_needed
! && (!rank_remap || se->use_offset))
{
gfc_conv_descriptor_offset_set (&loop.pre, parm,
gfc_conv_descriptor_offset_get (desc));
Index: gcc/testsuite/gfortran.dg/type_to_class_4.f03
===================================================================
*** gcc/testsuite/gfortran.dg/type_to_class_4.f03 (nonexistent)
--- gcc/testsuite/gfortran.dg/type_to_class_4.f03 (working copy)
***************
*** 0 ****
--- 1,34 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR56691 comment #7.
+ !
+ ! Contributed by Janus Weil <ja...@gcc.gnu.org>
+ !
+ module m2
+ implicit none
+ type :: t_stv
+ real :: f1
+ end type
+ contains
+ subroutine lcb(y)
+ class(t_stv), intent(in) :: y(:)
+ integer :: k
+ do k=1,size(y)
+ if (int(y(k)%f1) .ne. k) call abort
+ enddo
+ end subroutine
+ end module
+
+ program test
+ use m2
+ implicit none
+
+ type(t_stv), allocatable :: work(:)
+
+ allocate(work(4))
+ work(:)%f1 = (/ 1.,2.,3.,4./)
+
+ call lcb(work)
+ call lcb(work(:4)) ! Indexing used to be offset by 1.
+
+ end program
