https://gcc.gnu.org/bugzilla/show_bug.cgi?id=106790
Bug ID: 106790
Summary: Weird SIGSEV using polymorphic routine with "select
type" and optimization (-O3)
Product: gcc
Version: 12.1.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: federico.perini at gmail dot com
Target Milestone: ---
I'm getting a weird SIGSEV error when running the following code with full
optimization (-O3). Error happens if:
- type guard ("select type") is is "type is", no segfault if "class is"
- the non-abstract derived type contains more than 1 scalar
I suspect something is wrong with the compiler trying to optimize out the code
in the main program (it's all constants).
- Fails only on gfortran 11, 12.
- Works on gfortran 7,8,9,10
Test it here: https://godbolt.org/z/qKPMvKnzf
Here is the minimum working example:
module ttt
implicit none
type, abstract :: t0
contains
procedure(merge), deferred :: mergeWith
procedure(pprint), deferred :: print
end type
type,extends(t0) :: t
integer :: from1,to1,face
contains
procedure :: mergeWith => t_merge
procedure :: print => link_print
end type t
abstract interface
pure subroutine merge(this,that)
import t0
class(t0), intent(inout) :: this
class(t0), intent(in) :: that
end subroutine merge
function pprint(this) result(msg)
import t0
class(t0), intent(in) :: this
character(len=:), allocatable :: msg
end function pprint
end interface
contains
function link_print(this) result(msg)
class(t), intent(in) :: this
character(len=:), allocatable :: msg
character(len=1024) :: buffer
integer :: lt
write(buffer,1) this%to1,this%from1,this%face
lt = len_trim(buffer)
allocate(character(len=lt) :: msg)
if (lt>0) msg(1:lt) = buffer(1:lt)
1 format('to1=',i0,' from1=',i0,' face=',i0)
end function link_print
pure subroutine t_merge(this,that)
class(t), intent(inout) :: this
class(t0), intent(in) :: that
select type (ttype => that)
type is (t) ! Does not SIGSEV if using "class is (t)"
! SIGSEV at any of the following lines
! Does not crash anymore if commenting any of them
if (this%to1<0 .and. this%from1<0) then
this%to1 = ttype%to1
this%face = ttype%face
end if
end select
end subroutine t_merge
end module
program test_t
use ttt
implicit none
type(t) :: t1,t2
t1 = t(from1=123,to1=435,face=789)
t2 = t(from1=-1,to1=-1,face=-1)
call t1%mergeWith(t2)
print *, 't1=',t1%print(),' t2=',t2%print()
t1 = t(from1=123,to1=435,face=789)
t2 = t(from1=-1,to1=-1,face=-1)
! Crash here on -O3, apparently during the unrolling of constants
call t2%mergeWith(t1)
print *, 't1=',t1%print(),' t2=',t2%print()
end program
Thanks,
Federico
