mirror of
https://github.com/autc04/Retro68.git
synced 2024-09-28 18:56:06 +00:00
80 lines
2.0 KiB
Fortran
80 lines
2.0 KiB
Fortran
! { dg-do run }
|
|
!
|
|
! Check PDT type extension and simple OOP.
|
|
!
|
|
module vars
|
|
integer :: d_dim = 4
|
|
integer :: mat_dim = 256
|
|
integer, parameter :: ftype = kind(0.0d0)
|
|
end module
|
|
|
|
use vars
|
|
implicit none
|
|
integer :: i
|
|
type :: mytype (a,b)
|
|
integer, kind :: a = kind(0.0e0)
|
|
integer, LEN :: b = 4
|
|
integer :: i
|
|
real(kind = a) :: d(b, b)
|
|
end type
|
|
|
|
type, extends(mytype) :: thytype(h)
|
|
integer, kind :: h
|
|
integer(kind = h) :: j
|
|
end type
|
|
|
|
type x (q, r, s)
|
|
integer, kind :: q
|
|
integer, kind :: r
|
|
integer, LEN :: s
|
|
integer(kind = q) :: idx_mat(2,2) ! check these do not get treated as pdt_arrays.
|
|
type (mytype (b=s)) :: mat1
|
|
type (mytype (b=s*2)) :: mat2
|
|
end type x
|
|
|
|
real, allocatable :: matrix (:,:)
|
|
type(thytype(ftype, 4, 4)) :: w
|
|
type(x(8,4,256)) :: q
|
|
class(mytype(ftype, :)), allocatable :: cz
|
|
|
|
w%d = reshape ([(real(i), i = 1, d_dim*d_dim)],[d_dim,d_dim])
|
|
|
|
! Make sure that the type extension is ordering the parameters correctly.
|
|
if (w%a .ne. ftype) STOP 1
|
|
if (w%b .ne. 4) STOP 2
|
|
if (w%h .ne. 4) STOP 3
|
|
if (size (w%d) .ne. 16) STOP 4
|
|
if (int (w%d(2,4)) .ne. 14) STOP 5
|
|
if (kind (w%j) .ne. w%h) STOP 6
|
|
|
|
! As a side issue, ensure PDT components are OK
|
|
if (q%mat1%b .ne. q%s) STOP 7
|
|
if (q%mat2%b .ne. q%s*2) STOP 8
|
|
if (size (q%mat1%d) .ne. mat_dim**2) STOP 9
|
|
if (size (q%mat2%d) .ne. 4*mat_dim**2) STOP 10
|
|
|
|
! Now check some basic OOP with PDTs
|
|
matrix = w%d
|
|
|
|
! TODO - for some reason, using w%d directly in the source causes a seg fault.
|
|
allocate (cz, source = mytype(ftype, d_dim, 0, matrix))
|
|
select type (cz)
|
|
type is (mytype(ftype, *))
|
|
if (int (sum (cz%d)) .ne. 136) STOP 11
|
|
type is (thytype(ftype, *, 8))
|
|
STOP 12
|
|
end select
|
|
deallocate (cz)
|
|
|
|
allocate (thytype(ftype, d_dim*2, 8) :: cz)
|
|
cz%d = reshape ([(i*10, i = 1, cz%b**2)], [cz%b,cz%b])
|
|
select type (cz)
|
|
type is (mytype(ftype, *))
|
|
STOP 13
|
|
type is (thytype(ftype, *, 8))
|
|
if (int (sum (cz%d)) .ne. 20800) STOP 14
|
|
end select
|
|
|
|
deallocate (cz)
|
|
end
|