Dear All
I have encountered a strange issue that seems to be caused by some weird
interaction between gcc 13.3.0 and MPI (mpich/4.1.0).
With mpich/4.1 and gcc-13.3 the attached code runs with the results
$ ./tsm
hwloc/linux: Ignoring PCI device with non-16bit domain.
Pass --enable-32bits-pci-domain to configure to support such devices
(warning: it would break the library ABI, don't enable unless really
needed).
From check_save_smoothers 0: 0 F
From check_save_smoothers 1: 0 T
From check_save_smoothers 1.25: 0 T
0 check 1: T T
Program received signal SIGSEGV: Segmentation fault - invalid memory
reference.
Backtrace for this error:
#0 0x7f75dca5370f in ???
#1 0x401f79 in ???
#2 0x4026a0 in ???
#3 0x40280f in ???
#4 0x402861 in ???
#5 0x7f75dca3d087 in ???
#6 0x7f75dca3d14a in ???
#7 0x401144 in ???
#8 0xffffffffffffffff in ???
As you can see in the attached code, the allocation with a MOLD= argument
results in the inner component appearing to be allocated when it is
actually not (lines 152-155 of the source code) resulting in the message
" From check_save_smoothers 1.25: 0 T"
which is totally bogus (it should print F).
If I comment out anything related with MPI the code works fine; it also
works fine with mpich/4.1 compiled with other GCC versions (12.X, 13.1,
13.2, 14.1)
What would you suggest for further investigation/reporting?
Thanks
Salvatore Filippone
module const_mod
integer, parameter :: psb_mpk_ = selected_int_kind(8)
type :: psb_ctxt_type
integer(psb_mpk_), allocatable :: ctxt
end type psb_ctxt_type
end module const_mod
module penv_mod
use const_mod
contains
subroutine psb_init(ctxt)
use const_mod
use mpi
implicit none
type(psb_ctxt_type), intent(out) :: ctxt
integer(psb_mpk_) :: i, icomm
logical :: initialized
integer(psb_mpk_) :: np_, npavail, iam, info, basecomm
character(len=20), parameter :: name='psb_init'
integer(psb_mpk_) :: iinfo
!
call mpi_init(info)
basecomm = mpi_comm_world
call mpi_comm_dup(basecomm,icomm,info)
if (info == 0) then
ctxt%ctxt = icomm ! allocate on assignment
end if
end subroutine psb_init
subroutine psb_exit(ctxt)
type(psb_ctxt_type), intent(inout) :: ctxt
return
end subroutine psb_exit
end module penv_mod
module base_sv_mod
use const_mod
type base_sv_type
contains
end type base_sv_type
end module base_sv_mod
module base_sm_mod
use base_sv_mod
type base_sm_type
class(base_sv_type), allocatable :: sv
contains
procedure, pass(sm) :: free => base_sm_free
procedure, pass(sm) :: clone_settings => base_sm_clone_settings
end type base_sm_type
contains
subroutine base_sm_clone_settings(sm,smout,info)
Implicit None
! Arguments
class(base_sm_type), intent(inout) :: sm
class(base_sm_type), intent(inout) :: smout
integer(psb_mpk_), intent(out) :: info
info = 0
end subroutine base_sm_clone_settings
subroutine base_sm_free(sm,info)
! Arguments
class(base_sm_type), intent(inout) :: sm
integer(psb_mpk_), intent(out) :: info
info = 0
if (allocated(sm%sv)) deallocate(sm%sv,stat=info)
end subroutine base_sm_free
end module base_sm_mod
module jc_sm_mod
use base_sm_mod
type, extends(base_sm_type) :: jc_sm_type
contains
procedure, pass(sm) :: clone_settings => jc_sm_clone_settings
end type jc_sm_type
contains
subroutine jc_sm_clone_settings(sm,smout,info)
class(jc_sm_type), intent(inout) :: sm
class(base_sm_type), allocatable, intent(inout) :: smout
integer(psb_mpk_), intent(out) :: info
info = 0
write(0,*) name,' check 1:',allocated(smout%sv),allocated(sm%sv)
if (allocated(smout%sv)) write(0,*) name,' check 1.5:',same_type_as(sm%sv,smout%sv)
end subroutine jc_sm_clone_settings
end module jc_sm_mod
program tsm
use penv_mod
use jc_sm_mod
implicit none
! parallel environment
type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: iam, np
type(jc_sm_type) :: jacsmth
class(base_sm_type), allocatable :: save1, save2
! other variables
integer(psb_mpk_) :: info
character(len=20) :: name
info=0
call psb_init(ctxt)
allocate(jacsmth%sv)
call check_save_smoothers(jacsmth,save1, save2,info)
call psb_exit(ctxt)
stop
contains
subroutine check_save_smoothers(insmth,save1, save2,info)
class(base_sm_type), intent(inout) :: insmth
class(base_sm_type), allocatable, intent(inout) :: save1, save2
integer(psb_mpk_), intent(out) :: info
info = 0
if (allocated(save1)) then
call save1%free(info)
if (info == 0) deallocate(save1,stat=info)
if (info /= 0) then
write(0,*) 'Error from deallocate save1?',info
return
end if
end if
if (allocated(save2)) then
call save2%free(info)
if (info == 0) deallocate(save2,stat=info)
if (info /= 0) then
write(0,*) 'Error from deallocate save2?',info
return
end if
end if
write(0,*) 'From check_save_smoothers 0:',info,allocated(save1)
allocate(save1, mold=insmth,stat=info)
write(0,*) 'From check_save_smoothers 1:',info,allocated(save1)
if (allocated(save1)) write(0,*) 'From check_save_smoothers 1.25:',info,allocated(save1%sv)
if (info == 0) call insmth%clone_settings(save1,info)
write(0,*) 'Done first clone settings'
return
end subroutine check_save_smoothers
end program tsm
