[Bug fortran/85942] New: ICE with PDTs
juergen.reuter at desy dot de
gcc-bugzilla@gcc.gnu.org
Mon May 28 00:22:00 GMT 2018
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
More information about the Gcc-bugs
mailing list