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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
! RUN: %python %S/test_errors.py %s %flang_fc1
! Test restrictions on what subprograms can be used for defined assignment.
module m1
implicit none
type :: t
contains
!ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t4' and 't%assign_t5' as their interfaces are not distinguishable
!ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t4' and 't%assign_t6' as their interfaces are not distinguishable
!ERROR: Generic 'assignment(=)' may not have specific procedures 't%assign_t5' and 't%assign_t6' as their interfaces are not distinguishable
!ERROR: Defined assignment procedure 'binding' must be a subroutine
generic :: assignment(=) => binding
procedure :: binding => assign_t1
procedure :: assign_t
procedure :: assign_t2
procedure :: assign_t3
!ERROR: Defined assignment subroutine 'assign_t2' must have two dummy arguments
!WARNING: In defined assignment subroutine 'assign_t3', second dummy argument 'y' should have INTENT(IN) or VALUE attribute
!WARNING: In defined assignment subroutine 'assign_t4', first dummy argument 'x' should have INTENT(OUT) or INTENT(INOUT)
!ERROR: In defined assignment subroutine 'assign_t5', first dummy argument 'x' may not have INTENT(IN)
!ERROR: In defined assignment subroutine 'assign_t6', second dummy argument 'y' may not have INTENT(OUT)
generic :: assignment(=) => assign_t, assign_t2, assign_t3, assign_t4, assign_t5, assign_t6
procedure :: assign_t4
procedure :: assign_t5
procedure :: assign_t6
end type
type :: t2
contains
procedure, nopass :: assign_t
!ERROR: Defined assignment procedure 'assign_t' may not have NOPASS attribute
generic :: assignment(=) => assign_t
end type
contains
subroutine assign_t(x, y)
class(t), intent(out) :: x
type(t), intent(in) :: y
end
logical function assign_t1(x, y)
class(t), intent(out) :: x
type(t), intent(in) :: y
end
subroutine assign_t2(x)
class(t), intent(out) :: x
end
subroutine assign_t3(x, y)
class(t), intent(out) :: x
real :: y
end
subroutine assign_t4(x, y)
class(t) :: x
integer, intent(in) :: y
end
subroutine assign_t5(x, y)
class(t), intent(in) :: x
integer, intent(in) :: y
end
subroutine assign_t6(x, y)
class(t), intent(out) :: x
integer, intent(out) :: y
end
end
module m2
type :: t
end type
!ERROR: Generic 'assignment(=)' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
interface assignment(=)
!ERROR: In defined assignment subroutine 's1', dummy argument 'y' may not be OPTIONAL
subroutine s1(x, y)
import t
type(t), intent(out) :: x
real, optional, intent(in) :: y
end
!ERROR: In defined assignment subroutine 's2', dummy argument 'y' must be a data object
subroutine s2(x, y)
import t
type(t), intent(out) :: x
intent(in) :: y
interface
subroutine y()
end
end interface
end
!ERROR: In defined assignment subroutine 's3', second dummy argument 'y' must not be a pointer
subroutine s3(x, y)
import t
type(t), intent(out) :: x
type(t), intent(in), pointer :: y
end
!ERROR: In defined assignment subroutine 's4', second dummy argument 'y' must not be an allocatable
subroutine s4(x, y)
import t
type(t), intent(out) :: x
type(t), intent(in), allocatable :: y
end
end interface
end
! Detect defined assignment that conflicts with intrinsic assignment
module m5
type :: t
end type
interface assignment(=)
! OK - lhs is derived type
subroutine assign_tt(x, y)
import t
type(t), intent(out) :: x
type(t), intent(in) :: y
end
!OK - incompatible types
subroutine assign_il(x, y)
integer, intent(out) :: x
logical, intent(in) :: y
end
!OK - different ranks
subroutine assign_23(x, y)
integer, intent(out) :: x(:,:)
integer, intent(in) :: y(:,:,:)
end
!OK - scalar = array
subroutine assign_01(x, y)
integer, intent(out) :: x
integer, intent(in) :: y(:)
end
!ERROR: Defined assignment subroutine 'assign_10' conflicts with intrinsic assignment
subroutine assign_10(x, y)
integer, intent(out) :: x(:)
integer, intent(in) :: y
end
!ERROR: Defined assignment subroutine 'assign_ir' conflicts with intrinsic assignment
subroutine assign_ir(x, y)
integer, intent(out) :: x
real, intent(in) :: y
end
!ERROR: Defined assignment subroutine 'assign_ii' conflicts with intrinsic assignment
subroutine assign_ii(x, y)
integer(2), intent(out) :: x
integer(1), intent(in) :: y
end
end interface
end
|
