1! RUN: %S/test_errors.sh %s %t %f18
2! Test 15.5.2.5 constraints and restrictions for POINTER & ALLOCATABLE
3! arguments when both sides of the call have the same attributes.
4
5module m
6
7  type :: t
8  end type
9  type, extends(t) :: t2
10  end type
11  type :: pdt(n)
12    integer, len :: n
13  end type
14
15  type(t), pointer :: mp(:), mpmat(:,:)
16  type(t), allocatable :: ma(:), mamat(:,:)
17  class(t), pointer :: pp(:)
18  class(t), allocatable :: pa(:)
19  class(t2), pointer :: pp2(:)
20  class(t2), allocatable :: pa2(:)
21  class(*), pointer :: up(:)
22  class(*), allocatable :: ua(:)
23  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
24  type(pdt(*)), pointer :: amp(:)
25  !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
26  type(pdt(*)), allocatable :: ama(:)
27  type(pdt(:)), pointer :: dmp(:)
28  type(pdt(:)), allocatable :: dma(:)
29  type(pdt(1)), pointer :: nmp(:)
30  type(pdt(1)), allocatable :: nma(:)
31
32 contains
33
34  subroutine smp(x)
35    type(t), pointer :: x(:)
36  end subroutine
37  subroutine sma(x)
38    type(t), allocatable :: x(:)
39  end subroutine
40  subroutine spp(x)
41    class(t), pointer :: x(:)
42  end subroutine
43  subroutine spa(x)
44    class(t), allocatable :: x(:)
45  end subroutine
46  subroutine sup(x)
47    class(*), pointer :: x(:)
48  end subroutine
49  subroutine sua(x)
50    class(*), allocatable :: x(:)
51  end subroutine
52  subroutine samp(x)
53    type(pdt(*)), pointer :: x(:)
54  end subroutine
55  subroutine sama(x)
56    type(pdt(*)), allocatable :: x(:)
57  end subroutine
58  subroutine sdmp(x)
59    type(pdt(:)), pointer :: x(:)
60  end subroutine
61  subroutine sdma(x)
62    type(pdt(:)), allocatable :: x(:)
63  end subroutine
64  subroutine snmp(x)
65    type(pdt(1)), pointer :: x(:)
66  end subroutine
67  subroutine snma(x)
68    type(pdt(1)), allocatable :: x(:)
69  end subroutine
70
71  subroutine test
72    call smp(mp) ! ok
73    call sma(ma) ! ok
74    call spp(pp) ! ok
75    call spa(pa) ! ok
76    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
77    call smp(pp)
78    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
79    call sma(pa)
80    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
81    call spp(mp)
82    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so
83    call spa(ma)
84    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
85    call sup(pp)
86    !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
87    call sua(pa)
88    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
89    call spp(up)
90    !ERROR: Actual argument type 'CLASS(*)' is not compatible with dummy argument type 't'
91    call spa(ua)
92    !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
93    call spp(pp2)
94    !ERROR: POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind
95    call spa(pa2)
96    !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
97    call smp(mpmat)
98    !ERROR: Rank of dummy argument is 1, but actual argument has rank 2
99    call sma(mamat)
100    call sdmp(dmp) ! ok
101    call sdma(dma) ! ok
102    call snmp(nmp) ! ok
103    call snma(nma) ! ok
104    call samp(nmp) ! ok
105    call sama(nma) ! ok
106    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
107    call sdmp(nmp)
108    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
109    call sdma(nma)
110    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
111    call snmp(dmp)
112    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
113    call snma(dma)
114    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
115    call samp(dmp)
116    !ERROR: Dummy and actual arguments must defer the same type parameters when POINTER or ALLOCATABLE
117    call sama(dma)
118  end subroutine
119
120end module
121