MRE for pot3d `--fast` compilation

[Pranavchiku]

module xx
    type :: rp1d
        real, dimension(:), pointer :: f
    end type

    type :: sds
        integer, dimension(3) :: dims
        type(rp1d), dimension(3) :: scales
        real, dimension(:), pointer :: f
    end type
end module
subroutine sub()
    use xx
    real, dimension(:), pointer :: x
    call sub_to_allocate(x)
    print *, "x in sub = ", x
    deallocate(x)
    contains
    subroutine sub_to_allocate(x)
        use xx
        real, dimension(:), pointer :: x
        type(sds) :: s
        allocate(s%scales(1)%f(2))
        x => s%scales(1)%f
        x(1) = 2.0
        x(2) = 1.0
        print *, "x = ", x
    end subroutine
end subroutine
program derived_types_43
    implicit none
    call sub()
end program

% lfortran a.f90           
x = 
2.00000000e+00
1.00000000e+00

x in sub = 

% lfortran a.f90 --fast
x = 
2.00000000e+00
1.00000000e+00

x in sub = 

a.out(11318,0x1ec134c00) malloc: *** error for object 0x10028bef7: pointer being freed was not allocated
a.out(11318,0x1ec134c00) malloc: *** set a breakpoint in malloc_error_break to debug
% gfortran a.f90 && ./a.out
 x =    2.00000000       1.00000000    
 x in sub =    2.00000000       1.00000000    
% gfortran a.f90 -o3 && ./a.out            
 x =    2.00000000       1.00000000    
 x in sub =    2.00000000       1.00000000    

[gxyd]

MRE pretty much extracted from POT3D without any assumptions:

module sds_def
      implicit none
      integer, parameter, private :: mxdim = 3
      type :: rp1d
        real, dimension(:), pointer :: f
      end type

      type :: sds
        integer :: ndim
        integer, dimension(mxdim) :: dims
        type(rp1d), dimension(mxdim) :: scales
        real, dimension(:,:,:), pointer :: f
      end type
end module

program POT3D
      use sds_def
      implicit none
      real, dimension(:,:), pointer :: bn
      real, dimension(:), pointer :: tn
      integer :: ntn,npn
      call rdhdf_2d (ntn,npn,bn,tn)
      deallocate (bn)
      deallocate (tn)

      contains

      subroutine rdhdf_2d (nx,ny,f,x)
           implicit none
           integer :: nx,ny,i
           real, dimension(:,:), pointer :: f
           real, dimension(:), pointer :: x
           intent(out) :: nx,ny
           type(sds) :: s
           s%dims(:) = 1
           s%ndim = 2
           s%dims(1) = 5
           s%dims(2) = 7
           allocate (s%f(5,7,1))
           allocate(s%scales(1)%f(5))
           allocate(s%scales(2)%f(7))
           allocate (s%scales(3)%f(1))
           nx=s%dims(1)
           ny=s%dims(2)
           x=>s%scales(1)%f
           allocate (f(nx,ny))
           f(:,:)=s%f(:,:,1)
           deallocate (s%f)
      end subroutine
end program pot3d

On it's execution with LFortran, I get the below output/error:

> lfortran --version
LFortran version: 0.48.0-40-gbcc0dc28b-dirty
Platform: macOS ARM
LLVM: 11.1.0
Default target: arm64-apple-darwin23.6.0

> lfortran pot3d.F90 --fast
pot3d.out(36316,0x1feac4f40) malloc: *** error for object 0x104fa8080: pointer being freed was not allocated
pot3d.out(36316,0x1feac4f40) malloc: *** set a breakpoint in malloc_error_break to debug

> echo $?
6

> lfortran pot3d.F90
> echo $?
0

[Pranavchiku]

Bingo!

[Pranavchiku]

The fix seems simple, we just do not free a variable if it is a function argument and pointer / allocatable.

[Pranavchiku]

program derived_types_43
    type :: sds
        real, dimension(:), pointer :: f
    end type
    real, dimension(:), pointer :: x
    call sub_to_allocate(x)
    if ( abs(x(1) - 1.0) > 1e-8 ) error stop
    print *, "x in sub = ", x
    deallocate(x)
contains
    subroutine sub_to_allocate(x)
        real, dimension(:), pointer, intent(inout) :: x
        type(sds) :: s
        allocate(s%f(2))
        x => s%f
        x(1)=1.0
        x(2)=2.0
        print *, "x = ", x
    end subroutine
end program

% lfortran a.f90
x = 
1.00000000e+00
2.00000000e+00

x in sub = 
% echo $?
11
% gfortran a.f90 && ./a.out
 x =    1.00000000       2.00000000    
 x in sub =    1.00000000       2.00000000    

[Pranavchiku]

program derived_types_43
    type :: sds
        real, dimension(:), pointer :: f
    end type
    real, dimension(:), pointer :: x
    call sub_to_allocate(x)
    print *, "size(x): ", size(x)
    print *, "lbound(x): ", lbound(x)
    print *, "ubound(x): ", ubound(x)
    if ( abs(x(1) - 1.0) > 1e-8 ) error stop
    if ( abs(x(2) - 2.0) > 1e-8 ) error stop
    print *, "x in sub = ", x
    deallocate(x)
contains
    subroutine sub_to_allocate(x)
        real, dimension(:), pointer, intent(inout) :: x
        type(sds) :: s
        allocate(s%f(2))
        x => s%f
        x(1)=1.0

        print *, "x = ", x
    end subroutine
end program

% lfortran a.f90           
x = 
1.00000000e+00
2.00000000e+00

size(x):     2
lbound(x):     620765245
ubound(x):     628311471
% echo $?
11
% gfortran a.f90 && ./a.out
 x =    1.00000000       2.00000000    
 size(x):            2
 lbound(x):            1
 ubound(x):            2
 x in sub =    1.00000000       2.00000000    

[Pranavchiku]

program derived_types_43
    type :: sds
        real, dimension(:), pointer :: f
    end type
    real, dimension(:), pointer :: x
    call sub_to_allocate(x)
    print *, "size(x): ", size(x)
    print *, "lbound(x): ", lbound(x)
    if (lbound(x,1) /= 1) error stop
    print *, "ubound(x): ", ubound(x)
    if ( abs(x(1) - 1.0) > 1e-8 ) error stop
    if ( abs(x(2) - 2.0) > 1e-8 ) error stop
    print *, "x in sub = ", x
    deallocate(x)
contains
    subroutine sub_to_allocate(x)
        real, dimension(:), pointer, intent(inout) :: x
        type(sds) :: s
        allocate(s%f(2))
        x => s%f
        x(1)=1.0
        x(2)=2.0
        print *, "x = ", x
    end subroutine
end program

% lfortran a.f90
x = 
1.00000000e+00
2.00000000e+00

size(x):     2
lbound(x):     620765245
ERROR STOP
% gfortran a.f90 && ./a.out
 x =    1.00000000       2.00000000    
 size(x):            2
 lbound(x):            1
 ubound(x):            2
 x in sub =    1.00000000       2.00000000    

[certik]

Relevant issues:

• Previous PR: Fix : Copy dimension descriptors by value #6378, issue: array bounds are tampered somehow #6377
• Simplify the descriptor (remove pointer to pointer) #6612

[assem2002]

Some of the MRE outputs are OS dependent as we have undefined behavior here. But in general we get an error while printing after call to sub_to_allocate