pgfortran 13.3 bug: finalization, character... (?)

Compiler info:

pgfortran 13.3-0 64-bit target on x86-64 Linux -tp k8e

Command line:

pgfortran test2.f90 -o test2.exe; ./test2.exe

Output:

**debug(threed_deallocate): entering
**debug(threed_deallocate): on rec 1
**debug(image_deallocate): entering
 in mem?
  T
**debug(image_deallocate): exiting
**debug(threed_deallocate): deallocating rec array, size 1
**debug(image_deallocate): entering
 in mem?
  F
**debug(image_deallocate): exiting
**debug(image_deallocate): entering
 in mem?
Error: segmentation violation
   rax 0000000000000000, rbx 6563696e00000000, rcx 00000000005963c0
   rdx 00000000005963c0, rsp 0000007fbfffc8c0, rbp 0000007fbfffc8d0
   rsi 0000000000000000, rdi 0000000000000000, r8  0000000000000000
   r9  0000000000000001, r10 000000000045b1dc, r11 0000000000000246
   r12 0000000000000000, r13 6563696e00000000, r14 0000000000568ca0
   r15 0000000000000000
  --- traceback not available

Workaround:
Remove the assignment (" = ‘nice’ ") on line 4 of test2.f90

Output with workaround:

**debug(threed_deallocate): entering
**debug(threed_deallocate): on rec 1
**debug(image_deallocate): entering
 in mem?
  T
**debug(image_deallocate): exiting
**debug(threed_deallocate): deallocating rec array, size 1
**debug(image_deallocate): entering
 in mem?
  F
**debug(image_deallocate): exiting
**debug(threed_deallocate): deallocated rec array

test2.f90 (likely this can be trimmed further):

module images_base
    type image
        logical                                 ::  in_memory           =   .false.
        character(len=4)                        ::  type                =   'nice' ! Commenting the default assignment to 'nice' gets rid of problem 
        contains
            final   ::  image_deallocate
    end type image
contains

    subroutine image_allocate(img)
        type(image),                intent(inout)   ::  img
        if (img%in_memory) call image_deallocate(img)
        img%in_memory = .true.
    end subroutine image_allocate

    subroutine image_deallocate(img)
        type(image),    intent(inout) ::  img
        write(*,'(a)') '**debug(image_deallocate): entering'

        print *, 'in mem?'
        print *, img%in_memory

        if (img%in_memory) img%in_memory = .false.

        write(*,'(a)') '**debug(image_deallocate): exiting'
    end subroutine image_deallocate
end module images_base


module threeds_base
    use images_base
    type threed_reconstruction
        type(image)                 ::  vol_image
    end type threed_reconstruction

    type threed
        type(threed_reconstruction),    allocatable ::  rec(:)
        logical                     ::  in_memory               =   .false.
        contains
            final       ::  threed_deallocate
    end type threed
    contains

   subroutine threed_init( self )
        type(threed),                               intent(inout)   ::  self
        integer                                                     ::  nnum_of_recs, current_rec
        nnum_of_recs = 1
        if (allocated(self%rec)) deallocate(self%rec)
        allocate(self%rec(nnum_of_recs))
        if (self%in_memory) call threed_deallocate(self)
        do current_rec=1,size(self%rec)
            call image_allocate(self%rec(current_rec)%vol_image)
        enddo
        self%in_memory = .true.
    end subroutine threed_init


    subroutine threed_deallocate(self)
        type(threed),   intent(inout)   ::  self
        integer ::  current_rec
        logical, parameter :: debug = .true.
        write(*,'(a)') '**debug(threed_deallocate): entering'
        if (self%in_memory) then
            do current_rec=1,size(self%rec)
                write(*,'(a,i0)') '**debug(threed_deallocate): on rec ', current_rec
                call image_deallocate(self%rec(current_rec)%vol_image)
            enddo
            write(*,'(a,i0)') '**debug(threed_deallocate): deallocating rec array, size ', size(self%rec)
            deallocate(self%rec)
            write(*,'(a)') '**debug(threed_deallocate): deallocated rec array'
        endif
        self%in_memory = .false.
    end subroutine threed_deallocate
end module threeds_base

module threeds
    contains
    subroutine threed_unit_test_1()
        use threeds_base
        type(threed)    ::  self
        call threed_init(self)
    end subroutine threed_unit_test_1
end module

program testprog
 use threeds
 call threed_unit_test_1()
end program

Thanks Rohou. I’ve recreated the error here and passed it on to our compiler engineers for further investigation. This issue was logged as TPR#19230.

Best Regards,
Mat

thanks,
dave