https://gcc.gnu.org/bugzilla/show_bug.cgi?id=97380
Bug ID: 97380
Summary: polymorphic array assignment for `PACK`: ICE and
runtime segfaults
Product: gcc
Version: 10.2.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: ---
Created attachment 49351
--> https://gcc.gnu.org/bugzilla/attachment.cgi?id=49351&action=edit
program that reproduces the issue
I have ICE and runtime segfaults when performing polymorphic *array*
assignments with gfortran 7.4.0, 9.2.0 and 10.2.0.
- assignment using a DO loop --> everything OK
- assignment using an array, like: array(1:5) = array([2,4,6,8,10]) --> ICE
segfault
- assignment using PACK intrinsic, like: array(1:5) =
pack(array,mod([(j,j=1,10)],2)==0) --> RUNTIME segfault
This is a sample program that reproduces these issues:
module m
implicit none
type, public :: t
integer :: i = 0
contains
procedure, private, pass(this) :: t_assign => t_to_t
generic :: assignment(=) => t_assign
end type t
type, public, extends(t) :: tt
integer :: j = 0
contains
procedure, private, pass(this) :: t_assign => t_to_tt
end type tt
contains
elemental subroutine t_to_t(this,that)
class(t), intent(inout) :: this
class(t), intent(in ) :: that
this%i = that%i
end subroutine t_to_t
elemental subroutine t_to_tt(this,that)
class(tt), intent(inout) :: this
class(t ), intent(in ) :: that
this%i = that%i
select type (thatPtr=>that)
type is (t)
this%j = 0
type is (tt)
this%j = thatPtr%j
class default
! Cannot stop here
this%i = -1
this%j = -1
end select
end subroutine t_to_tt
end module m
program test_poly_pack
use m
implicit none
integer, parameter :: n = 100
integer :: i,j
class(t), allocatable :: poly(:),otherPoly(:)
allocate(t :: poly(n))
allocate(t :: otherPoly(10))
! Assign dummy values
forall(i=1:n) poly(i)%i = i
! Array assignment with indices => ICE segfault:
! internal compiler error: Segmentation fault
otherPoly(1:10) = poly([10,20,30,40,50,60,70,80,90,100])
! Scalar assignment with loop -> OK
do i=1,10
otherPoly(i) = poly(10*i)
end do
! Array assignment with PACK => Compiles OK, Segfault on runtime. GDB
returns:
! Thread 1 received signal SIGSEGV, Segmentation fault.
! 0x000000000040163d in m::t_to_t (this=..., that=...) at
test_poly_pack.f90:31
! 31 this%i = that%i
otherPoly(1:10) = pack(poly,mod([(j,j=1,100)],10)==0)
do i=1,10
print *, ' polymorphic(',i,')%i = ',otherPoly(i)%i
end do
end program test_poly_pack
Thanks,
Federico
