https://gcc.gnu.org/bugzilla/show_bug.cgi?id=85942
Bug ID: 85942 Summary: ICE with PDTs Product: gcc Version: 9.0 Status: UNCONFIRMED Severity: normal Priority: P3 Component: fortran Assignee: unassigned at gcc dot gnu.org Reporter: juergen.reuter at desy dot de Target Milestone: --- The following code from c.l.f. thread from Sep 28, 2015. ("Vectors on everyday physics") leads to an ICE with gfortran 9.0, but works without problems with ifort 18 and 19, cf. code below. The expected output would be: matrix mat_r4: kind = 4 matrix mat_r4: num cols = 2 matrix mat_r4: num rows = 3 a_r4 = 1.000000 2.000000 3.000000 4.000000 5.000000 6.000000 matrix mat_r8: kind = 8 matrix mat_r8: num cols = 4 matrix mat_r8: num rows = 4 a_r8 = 1.00000000000000 2.00000000000000 3.00000000000000 4.00000000000000 5.00000000000000 6.00000000000000 7.00000000000000 8.00000000000000 9.00000000000000 10.0000000000000 11.0000000000000 12.0000000000000 13.0000000000000 14.0000000000000 15.0000000000000 16.0000000000000 Code leading to the segfault: module mykinds use, intrinsic :: iso_fortran_env, only : i4 => int32, r4 => real32, r8 => real64 implicit none private public :: i4, r4, r8 end module mykinds module matrix use mykinds, only : r4, r8 implicit none private type, public :: mat_t(k,c,r) private !.. type parameters integer, kind :: k = r4 integer, len :: c = 1 integer, len :: r = 1 !.. private by default !.. type data real(kind=k) :: m_a(c,r) end type mat_t interface assignment(=) module procedure geta_r4 module procedure seta_r4 module procedure geta_r8 module procedure seta_r8 !.. additional bindings elided end interface assignment(=) public :: assignment(=) contains subroutine geta_r4(a_lhs, t_rhs) real(r4), allocatable, intent(out) :: a_lhs(:,:) class(mat_t(k=r4,c=*,r=*)), intent(in) :: t_rhs a_lhs = t_rhs%m_a return end subroutine geta_r4 subroutine geta_r8(a_lhs, t_rhs) real(r8), allocatable, intent(out) :: a_lhs(:,:) class(mat_t(k=r8,c=*,r=*)), intent(in) :: t_rhs a_lhs = t_rhs%m_a return end subroutine geta_r8 subroutine seta_r4(t_lhs, a_rhs) class(mat_t(k=r4,c=*,r=*)), intent(inout) :: t_lhs real(r4), intent(in) :: a_rhs(:,:) !.. checks on size elided t_lhs%m_a = a_rhs return end subroutine seta_r4 subroutine seta_r8(t_lhs, a_rhs) class(mat_t(k=r8,c=*,r=*)), intent(inout) :: t_lhs real(r8), intent(in) :: a_rhs(:,:) !.. checks on size elided t_lhs%m_a = a_rhs return end subroutine seta_r8 end module matrix program p use mykinds, only : r4, r8 use matrix, only : mat_t, assignment(=) implicit none type(mat_t(k=r4,c=:,r=:)), allocatable :: mat_r4 type(mat_t(k=r8,c=:,r=:)), allocatable :: mat_r8 real(r4), allocatable :: a_r4(:,:) real(r8), allocatable :: a_r8(:,:) integer :: N integer :: M integer :: i integer :: istat N = 2 M = 3 allocate( mat_t(k=r4,c=N,r=M) :: mat_r4, stat=istat ) if ( istat /= 0 ) then print *, " error allocating mat_r4: stat = ", istat stop end if print *, " matrix mat_r4: kind = ", mat_r4%k print *, " matrix mat_r4: num cols = ", mat_r4%c print *, " matrix mat_r4: num rows = ", mat_r4%r mat_r4 = reshape( [ (real(i, kind=mat_r4%k), i=1,N*M) ], [ N, M ] ) a_r4 = mat_r4 print *, " a_r4 = ", a_r4 N = 4 M = 4 allocate( mat_t(k=r8,c=N,r=M) :: mat_r8, stat=istat ) if ( istat /= 0 ) then print *, " error allocating mat_r4: stat = ", istat stop end if print *, " matrix mat_r8: kind = ", mat_r8%k print *, " matrix mat_r8: num cols = ", mat_r8%c print *, " matrix mat_r8: num rows = ", mat_r8%r mat_r8 = reshape( [ (real(i, kind=mat_r8%k), i=1,N*M) ], [ N, M ] ) a_r8 = mat_r8 print *, " a_r8 = ", a_r8 deallocate( mat_r4, stat=istat ) if ( istat /= 0 ) then print *, " error deallocating mat_r4: stat = ", istat stop end if deallocate( mat_r8, stat=istat ) if ( istat /= 0 ) then print *, " error deallocating mat_r4: stat = ", istat stop end if stop end program p