1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
! { dg-do run }
! { dg-options "-fcheck=all" }
!
! Basic check of Parameterized Derived Types.
!
! -fcheck=all is used here to ensure that when the parameter
! 'b' of the dummy in 'foo' is assumed, there is no error.
! Likewise in 'bar' and 'foobar', when 'b' has the correct
! explicit value.
!
implicit none
integer, parameter :: ftype = kind(0.0e0)
integer :: pdt_len = 4
integer :: i
type :: mytype (a,b)
integer, kind :: a = kind(0.0d0)
integer, LEN :: b
integer :: i
real(kind = a) :: d(b, b)
character (len = b*b) :: chr
end type
type(mytype(b=4)) :: z(2)
type(mytype(ftype, 4)) :: z2
z(1)%i = 1
z(2)%i = 2
z(1)%d = reshape ([(real(i), i = 1, 16)],[4,4])
z(2)%d = 10*z(1)%d
z(1)%chr = "hello pdt"
z(2)%chr = "goodbye pdt"
z2%d = z(1)%d * 10 - 1
z2%chr = "scalar pdt"
call foo (z)
call bar (z)
call foobar (z2)
contains
elemental subroutine foo (arg)
type(mytype(8,*)), intent(in) :: arg
if (arg%i .eq. 1) then
if (trim (arg%chr) .ne. "hello pdt") error stop
if (int (sum (arg%d)) .ne. 136) error stop
else if (arg%i .eq. 2 ) then
if (trim (arg%chr) .ne. "goodbye pdt") error stop
if (int (sum (arg%d)) .ne. 1360) error stop
else
error stop
end if
end subroutine
subroutine bar (arg)
type(mytype(b=4)) :: arg(:)
if (int (sum (arg(1)%d)) .ne. 136) STOP 1
if (trim (arg(2)%chr) .ne. "goodbye pdt") STOP 2
end subroutine
subroutine foobar (arg)
type(mytype(ftype, pdt_len)) :: arg
if (int (sum (arg%d)) .ne. 1344) STOP 3
if (trim (arg%chr) .ne. "scalar pdt") STOP 4
end subroutine
end
|
