A slightly modified code below (in which I’ve added more integer components with initialized values)
program pointer_array_to_struct
implicit none
type :: str
integer :: data = -999
integer :: a = 1
integer :: b = 2
integer :: c = 300
integer :: d = 400
integer :: e = 500
end type
type(str), target :: e(8)
integer :: i,j,array_sum,loop_sum
integer, pointer :: dd(:)
integer, parameter :: idx(8) = [(i,i=1,8)]
! Set data
e%data = idx
dd=>e%data
print *, size(dd), lbound(dd), ubound(dd)
print *, "dd(:) = ", dd(:)
print *, "sum(idx(dd)) = ", sum(idx(dd))
associate (ee => e% data)
print *, "sum(idx(ee)) = ", sum(idx(ee))
end associate
loop_sum = 0
do j=1,size(dd)
loop_sum = loop_sum+idx(dd(j))
end do
print *, 'expected =',sum(idx)
print *, ' loop_sum=', loop_sum
end program
gives this error:
8 1 8
dd(:) = 1 2 3 4 5 6 7 8
Program stderr
At line 27 of file /app/example.f90
Fortran runtime error: Index '300' of dimension 1 of array 'idx' outside of expected range (1:8)
so maybe the compiler assumes stride=1 (or something) erroneously when evaluating idx(dd)
via vector indexing? (The same error occurs also when I use associate (ee => e% data)
and evaluate idx(ee)
.) I wonder if this bug is also related to the issue of complex arrays (and .span
thing)
FWIW, Lfortran0.5.2 gives (for the same code)
8 1 8
dd(:) = 1 1 2 300 400 500 2 1
sum(idx(dd)) = 7
sum(idx(ee)) = 36
expected = 36
loop_sum= 7
which seems also assume stride=1, but here when making an array descriptor (?) itself (while the associate
seems to be working correctly). Other compilers (ifx, ifort, flang, nvfortran) give the expected results (36) in all cases.