[Patch, fortran] PR 56691 - [OOP] Allocatable array: wrong offset when passing to CLASS dummy

[Paul Richard Thomas <paul.richard.thomas@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 609 bytes --]

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  <pault@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  <pault@gcc.gnu.org>

    PR fortran/56691
    * gfortran.dg/type_to_class_4.f03: New test.

[-- Attachment #2: submit.diff --]
[-- Type: text/plain, Size: 1902 bytes --]

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  <janus@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