Contiguous/strided pointer bounds issue

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.