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