I will get a bug report for IFX.
It is the type constructor that is tripping up ifx. I reduced this to the following. You will see that if you replace the type constructor with an allocate and explicit initialization of df_new%values you will get correct results with IFX. I have a note below, this is a regression in ifx with 2025.0 and will also be in 2025.1 when it releases in the coming days
module dataframe_mod
implicit none
private
public :: DataFrame, display, subset_stride
type :: DataFrame
real(kind=4), allocatable :: values(:,:)
end type DataFrame
contains
subroutine display(self)
class(DataFrame) :: self
integer :: i
do i = 1, UBOUND(self%values,dim=1)
write(*,"(1x,A,I1,*(1x,f10.4))") "row: ", i, self%values(i,:)
end do
end subroutine display
function subset_stride(df) result(df_new)
type(DataFrame) :: df
type(DataFrame) :: df_new
!...suspect below ...
df_new = DataFrame(values = df%values(1:8:3, :))
!...can fix this by explicitly setting result df_new
! uncomment_for_working_testcase
!allocate(df_new%values(3,2))
!df_new%values(1,:) = [ 1.1, 1.2 ]
!df_new%values(2,:) = [ 4.1, 4.2 ]
!df_new%values(3,:) = [ 7.1, 7.2 ]
end function subset_stride
end module dataframe_mod
program xxdataframe
use dataframe_mod
implicit none
type(DataFrame) :: df, df_new
allocate(df%values(8,2) )
df%values(1,:) = [ 1.1, 1.2 ]
df%values(2,:) = [ 2.1, 2.2 ]
df%values(3,:) = [ 3.1, 3.2 ]
df%values(4,:) = [ 4.1, 4.2 ]
df%values(5,:) = [ 5.1, 5.2 ]
df%values(6,:) = [ 6.1, 6.2 ]
df%values(7,:) = [ 7.1, 7.2 ]
df%values(8,:) = [ 8.1, 8.2 ]
write(*,*) "display initial values of df"
call display(df)
write(*,*)
df_new = subset_stride(df)
write(*,*) "print df_new, should have rows 1, 4, 7 "
write(*,*) "shape(df_new%values)", shape(df_new%values)
write(*,*) "bounds of df_new%values, dim 1: ", LBOUND(df_new%values,1), UBOUND(df_new%values,1)
write(*,*) "bounds of df_new%values, dim 2: ", LBOUND(df_new%values,2), UBOUND(df_new%values,2)
call display(df_new)
end program xxdataframe
A few interesting points in this triage: this is a regression in IFX. the last good version was 2024.2.0. It regressed in 2025.0.0. gfortran 11.4 does not error with this reproducer, so perhaps the gfortran issue is different than the one shown in ifx. Here is the erroneous output of ifx 2025.0 and the upcoming 2025.1 (too late to fix this one in v2025.1.0, its almost out of the door)
rm a.out ; ifx -O0 repro.f90 ; ./a.out
display initial values of df
row: 1 1.1000 1.2000
row: 2 2.1000 2.2000
row: 3 3.1000 3.2000
row: 4 4.1000 4.2000
row: 5 5.1000 5.2000
row: 6 6.1000 6.2000
row: 7 7.1000 7.2000
row: 8 8.1000 8.2000
print df_new, should have rows 1, 4, 7
shape(df_new%values) 3 2
bounds of df_new%values, dim 1: 1 3
bounds of df_new%values, dim 2: 1 2
row: 1 1.1000 0.0000
row: 2 2.1000 0.0000
row: 3 3.1000 0.0000
another interesting point - this is a case where the new LLVM Address Sanitizer will find memory corruption caused by this bug. The option for this is -fsanitize=address and run the code.
rm a.out ; ifx -O0 -fsanitize=address repro.f90 ; ./a.out
display initial values of df
row: 1 1.1000 1.2000
row: 2 2.1000 2.2000
row: 3 3.1000 3.2000
row: 4 4.1000 4.2000
row: 5 5.1000 5.2000
row: 6 6.1000 6.2000
row: 7 7.1000 7.2000
row: 8 8.1000 8.2000
print df_new, should have rows 1, 4, 7
shape(df_new%values) 3 2
bounds of df_new%values, dim 1: 1 3
bounds of df_new%values, dim 2: 1 2
=================================================================
==212239==ERROR: AddressSanitizer: heap-buffer-overflow on address 0x506000000120 at pc 0x00000051a32f bp 0x7fff9fe97030 sp 0x7fff9fe97028
READ of size 4 at 0x506000000120 thread T0
#0 0x51a32e in dataframe_mod::display_ (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x51a32e) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3)
#1 0x51e06b in MAIN (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x51e06b) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3)
#2 0x43114c in main (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x43114c) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3)
#3 0x7f3c7fee8d8f (/lib/x86_64-linux-gnu/libc.so.6+0x29d8f) (BuildId: cd410b710f0f094c6832edd95931006d883af48e)
#4 0x7f3c7fee8e3f in __libc_start_main (/lib/x86_64-linux-gnu/libc.so.6+0x29e3f) (BuildId: cd410b710f0f094c6832edd95931006d883af48e)
#5 0x431064 in _start (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x431064) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3)
0x506000000120 is located 0 bytes after 64-byte region [0x5060000000e0,0x506000000120)
allocated by thread T0 here:
#0 0x4d8af3 in malloc (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x4d8af3) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3)
#1 0x579944 in _mm_malloc (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x579944) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3)
#2 0x51da45 in MAIN (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x51da45) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3)
#3 0x43114c in main (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x43114c) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3)
#4 0x7f3c7fee8d8f (/lib/x86_64-linux-gnu/libc.so.6+0x29d8f) (BuildId: cd410b710f0f094c6832edd95931006d883af48e)
SUMMARY: AddressSanitizer: heap-buffer-overflow (/nfs/pdx/disks/cts1/quad/rwgreen/triage/f-discourse/a.out+0x51a32e) (BuildId: 3ab273d6e76114ff1028e32bec14e8ed21fcdfb3) in dataframe_mod::display_
Shadow bytes around the buggy address:
0x505ffffffe80: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0x505fffffff00: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0x505fffffff80: 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
0x506000000000: fa fa fa fa 00 00 00 00 00 00 00 fa fa fa fa fa
0x506000000080: fd fd fd fd fd fd fd fd fa fa fa fa 00 00 00 00
=>0x506000000100: 00 00 00 00[fa]fa fa fa fa fa fa fa fa fa fa fa
0x506000000180: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
0x506000000200: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
0x506000000280: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
0x506000000300: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
0x506000000380: fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa fa
Shadow byte legend (one shadow byte represents 8 application bytes):
Addressable: 00
Partially addressable: 01 02 03 04 05 06 07
Heap left redzone: fa
Freed heap region: fd
Stack left redzone: f1
Stack mid redzone: f2
Stack right redzone: f3
Stack after return: f5
Stack use after scope: f8
Global redzone: f9
Global init order: f6
Poisoned by user: f7
Container overflow: fc
Array cookie: ac
Intra object redzone: bb
ASan internal: fe
Left alloca redzone: ca
Right alloca redzone: cb
==212239==ABORTING