[Fortran, Patch, PR 96992] Fix Class arrays of different ranks are rejected as storage association argument

[Harald Anlauf]

Hi Andre,

Am 19.06.24 um 09:07 schrieb Andre Vehreschild:
> Hi Harald,
>
> thank you for the investigation and useful tips. I had to figure what went
> wrong here, but I now figured, that the array needs repacking when a negative
> stride is used (or at least a call to that routine, which then fixes "stuff").
> I have added it, freeing the memory allocated potentially by pack, and also
> updated the testcase to include the negative stride.

hmmm, the pack does not always get generated:

module foo_mod
   implicit none
   type foo
      integer :: i
   end type foo
contains
   subroutine d1(x,n)
     integer, intent(in) :: n
     integer :: i
     class (foo), intent(out) :: x(n)
     select type(x)
     class is(foo)
        x(:)%i = (/ (42 + i, i = 1, n ) /)
     class default
        stop 1
     end select
   end subroutine d1
   subroutine d2(x,n)
     integer, intent(in) :: n
     integer :: i
     class (foo), intent(in) :: x(n,n,n)
     select type (x)
     class is (foo)
        print *,"d2:  ", x%i
        if ( any( x%i /= reshape((/ (42 + i, i = 1, n ** 3 ) /), [n, n,
n] ))) stop 2
     class default
        stop 3
     end select
   end subroutine d2

   subroutine d3(x,n)
     integer, intent(in) :: n
     integer :: i
     class (foo), intent(inout) :: x(n)
     select type (x)
     class is (foo)
        print *,"d3_1:", x%i
        x%i = -x%i               ! Simply negate elements
        print *,"d3_2:", x%i
     class default
        stop 33
     end select
   end subroutine d3
end module foo_mod
program main
   use foo_mod
   implicit none
   type (foo), dimension(:), allocatable :: f
   integer :: n, k, m
   n = 2
   allocate (f(n*n*n))
   ! Original testcase:
   call d1(f,n*n*n)
   print *, "d1->:", f%i
   call d2(f,n)
   ! Ensure that array f is ok:
   print *, "d2->:", f%i

   ! The following shows that no appropriate internal pack is generated:
   call d1(f,n*n*n)
   print *, "d1->:", f%i
   m = n*n*n
   k = 3
   print *, "->d3:", f(1:m:k)%i
   call d3(f(1:m:k),1+(m-1)/k)
   print *, "d3->:", f(1:m:k)%i
   print *, "full:", f%i
   deallocate (f)
end program main


After the second version of your patch this prints:

  d1->:          43          44          45          46          47
     48          49          50
  d2:            43          44          45          46          47
     48          49          50
  d2->:          43          44          45          46          47
     48          49          50
  d1->:          43          44          45          46          47
     48          49          50
  ->d3:          43          46          49
  d3_1:          43          44          45
  d3_2:         -43         -44         -45
  d3->:         -43          46          49
  full:         -43         -44         -45          46          47
     48          49          50

While the print properly handles f(1:m:k)%i, passing it as
actual argument to subroutine d3 does not do pack/unpack.

Can you have another look?

Thanks,
Harald


> Regtests fine on x86_64-pc-linux-gnu/Fedora 39. Ok for mainline?
>
> Regards,
> 	Andre
>
> On Sun, 16 Jun 2024 23:27:46 +0200
> Harald Anlauf <anlauf@gmx.de> wrote:
>
> << snipped for brevity >>>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de