xref: /llvm-project/flang/test/Semantics/resolve52.f90 (revision 9fdde69f72f6145d220645d1b218b4c6f2be2c13) 
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! Tests for C760:
3! The passed-object dummy argument shall be a scalar, nonpointer, nonallocatable
4! dummy data object with the same declared type as the type being defined;
5! all of its length type parameters shall be assumed; it shall be polymorphic
6! (7.3.2.3) if and only if the type being defined is extensible (7.5.7).
7! It shall not have the VALUE attribute.
8!
9! C757 If the procedure pointer component has an implicit interface or has no
10! arguments, NOPASS shall be specified.
11!
12! C758 If PASS (arg-name) appears, the interface of the procedure pointer
13! component shall have a dummy argument named arg-name.
14
15
16module m1
17  type :: t
18    procedure(real), pointer, nopass :: a
19    !ERROR: Procedure component 'b' must have NOPASS attribute or explicit interface
20    procedure(real), pointer :: b
21  end type
22end
23
24module m2
25  type :: t
26    !ERROR: Procedure component 'a' with no dummy arguments must have NOPASS attribute
27    procedure(s1), pointer :: a
28    !ERROR: Procedure component 'b' with no dummy arguments must have NOPASS attribute
29    procedure(s1), pointer, pass :: b
30  contains
31    !ERROR: Procedure binding 'p1' with no dummy arguments must have NOPASS attribute
32    procedure :: p1 => s1
33    !ERROR: Procedure binding 'p2' with no dummy arguments must have NOPASS attribute
34    procedure, pass :: p2 => s1
35  end type
36contains
37  subroutine s1()
38  end
39end
40
41module m3
42  type :: t
43    !ERROR: 'y' is not a dummy argument of procedure interface 's'
44    procedure(s), pointer, pass(y) :: a
45  contains
46    !ERROR: 'z' is not a dummy argument of procedure interface 's'
47    procedure, pass(z) :: p => s
48  end type
49contains
50  subroutine s(x)
51    class(t) :: x
52  end
53  subroutine test
54    type(t) x
55    !ERROR: Dummy argument 'x=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference
56    call x%p
57  end
58end
59
60module m4
61  type :: t
62    !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not have the POINTER attribute
63    procedure(s1), pointer :: a
64    !ERROR: Passed-object dummy argument 'x' of procedure 'b' may not have the ALLOCATABLE attribute
65    procedure(s2), pointer, pass(x) :: b
66    !ERROR: Passed-object dummy argument 'f' of procedure 'c' must be a data object
67    procedure(s3), pointer, pass :: c
68    !ERROR: Passed-object dummy argument 'x' of procedure 'd' must be scalar
69    procedure(s4), pointer, pass :: d
70  end type
71contains
72  subroutine s1(x)
73    class(t), pointer :: x
74  end
75  subroutine s2(w, x)
76    real :: x
77    !ERROR: The type of 'x' has already been declared
78    class(t), allocatable :: x
79  end
80  subroutine s3(f)
81    interface
82      real function f()
83      end function
84    end interface
85  end
86  subroutine s4(x)
87    class(t) :: x(10)
88  end
89end
90
91module m5
92  type :: t1
93    sequence
94    !ERROR: Passed-object dummy argument 'x' of procedure 'a' must be of type 't1' but is 'REAL(4)'
95    procedure(s), pointer :: a
96  end type
97  type :: t2
98  contains
99    !ERROR: Passed-object dummy argument 'y' of procedure 's' must be of type 't2' but is 'TYPE(t1)'
100    procedure, pass(y) :: s
101  end type
102contains
103  subroutine s(x, y)
104    real :: x
105    type(t1) :: y
106  end
107end
108
109module m6
110  type :: t(k, l)
111    integer, kind :: k
112    integer, len :: l
113    !ERROR: Passed-object dummy argument 'x' of procedure 'a' has non-assumed length parameter 'l'
114    procedure(s1), pointer :: a
115  end type
116contains
117  subroutine s1(x)
118    class(t(1, 2)) :: x
119  end
120end
121
122module m7
123  type :: t
124    sequence  ! t is not extensible
125    !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not be polymorphic because 't' is not extensible
126    procedure(s), pointer :: a
127  end type
128contains
129  subroutine s(x)
130    !ERROR: Non-extensible derived type 't' may not be used with CLASS keyword
131    class(t) :: x
132  end
133end
134
135module m8
136  type :: t
137  contains
138    !ERROR: Passed-object dummy argument 'x' of procedure 's' must be polymorphic because 't' is extensible
139    procedure :: s
140  end type
141contains
142  subroutine s(x)
143    type(t) :: x  ! x is not polymorphic
144  end
145end
146