File: assign04.f90

package info (click to toggle)
swiftlang 6.0.3-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 2,519,992 kB
  • sloc: cpp: 9,107,863; ansic: 2,040,022; asm: 1,135,751; python: 296,500; objc: 82,456; f90: 60,502; lisp: 34,951; pascal: 19,946; sh: 18,133; perl: 7,482; ml: 4,937; javascript: 4,117; makefile: 3,840; awk: 3,535; xml: 914; fortran: 619; cs: 573; ruby: 573
file content (280 lines) | stat: -rw-r--r-- 7,196 bytes parent folder | download | duplicates (3)
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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
! RUN: %python %S/test_errors.py %s %flang_fc1
! 9.4.5
subroutine s1
  type :: t(k, l)
    integer, kind :: k
    integer, len :: l
  end type
  type(t(1, 2)) :: x
  !ERROR: Assignment to constant 'x%k' is not allowed
  x%k = 4
  !ERROR: Assignment to constant 'x%l' is not allowed
  x%l = 3
end

! C901
subroutine s2(x)
  !ERROR: A dummy argument may not also be a named constant
  real, parameter :: x = 0.0
  real, parameter :: a(*) = [1, 2, 3]
  character, parameter :: c(2) = "ab"
  integer :: i
  !ERROR: Assignment to constant 'x' is not allowed
  x = 2.0
  i = 2
  !ERROR: Left-hand side of assignment is not definable
  !BECAUSE: 'a' is not a variable
  a(i) = 3.0
  !ERROR: Left-hand side of assignment is not definable
  !BECAUSE: 'a' is not a variable
  a(i:i+1) = [4, 5]
  !ERROR: Left-hand side of assignment is not definable
  !BECAUSE: 'c' is not a variable
  c(i:2) = "cd"
end

! C901
subroutine s3
  type :: t
    integer :: a(2)
    integer :: b
  end type
  type(t) :: x
  type(t), parameter :: y = t([1,2], 3)
  integer :: i = 1
  x%a(i) = 1
  !ERROR: Left-hand side of assignment is not definable
  !BECAUSE: 'y' is not a variable
  y%a(i) = 2
  x%b = 4
  !ERROR: Assignment to constant 'y%b' is not allowed
  y%b = 5
end

! C844
subroutine s4
  type :: t
    integer :: a(2)
  end type
contains
  subroutine s(x, c)
    type(t), intent(in) :: x
    character(10), intent(in) :: c
    type(t) :: y
    !ERROR: Left-hand side of assignment is not definable
    !BECAUSE: 'x' is an INTENT(IN) dummy argument
    x = y
    !ERROR: Left-hand side of assignment is not definable
    !BECAUSE: 'x' is an INTENT(IN) dummy argument
    x%a(1) = 2
    !ERROR: Left-hand side of assignment is not definable
    !BECAUSE: 'c' is an INTENT(IN) dummy argument
    c(2:3) = "ab"
  end
end

! 8.5.15(2)
module m5
  real :: x
  real, protected :: y
  real, private :: z
  type :: t
    real :: a
  end type
  type(t), protected :: b
end
subroutine s5()
  use m5
  implicit none
  x = 1.0
  !ERROR: Left-hand side of assignment is not definable
  !BECAUSE: 'y' is protected in this scope
  y = 2.0
  !ERROR: No explicit type declared for 'z'
  z = 3.0
  !ERROR: Left-hand side of assignment is not definable
  !BECAUSE: 'b' is protected in this scope
  b%a = 1.0
end

subroutine s6(x)
  integer :: x(*)
  x(1:3) = [1, 2, 3]
  x(:3) = [1, 2, 3]
  !ERROR: Assumed-size array 'x' must have explicit final subscript upper bound value
  x(:) = [1, 2, 3]
  !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
  x = [1, 2, 3]
end

module m7
  type :: t
    integer :: i
  end type
contains
  subroutine s7(x)
    type(t) :: x(*)
    x(:3)%i = [1, 2, 3]
    !ERROR: Whole assumed-size array 'x' may not appear here without subscripts
    x%i = [1, 2, 3]
  end
end

subroutine s7
  integer :: a(10), v(10)
  a(v(:)) = 1  ! vector subscript is ok
end

subroutine s8
  !ERROR: Assignment to procedure 's8' is not allowed
  s8 = 1.0
end

real function f9() result(r)
  !ERROR: Assignment to procedure 'f9' is not allowed
  f9 = 1.0
end

subroutine s9
  real f9a
  !ERROR: Assignment to procedure 'f9a' is not allowed
  f9a = 1.0
  print *, f9a(1)
end

!ERROR: No explicit type declared for dummy argument 'n'
subroutine s10(a, n)
  implicit none
  real a(n)
  a(1:n) = 0.0  ! should not get a second error here
end

subroutine s11
  intrinsic :: sin
  real :: a
  !ERROR: Function call must have argument list
  a = sin
  !ERROR: Subroutine name is not allowed here
  a = s11
end

subroutine s12()
  type dType(l1, k1, l2, k2)
    integer, len :: l1
    integer, kind :: k1
    integer, len :: l2
    integer, kind :: k2
  end type

  contains
    subroutine sub(arg1, arg2, arg3)
      integer :: arg1
      type(dType(arg1, 2, *, 4)) :: arg2
      type(dType(*, 2, arg1, 4)) :: arg3
      type(dType(1, 2, 3, 4)) :: local1
      type(dType(1, 2, 3, 4)) :: local2
      type(dType(1, 2, arg1, 4)) :: local3
      type(dType(9, 2, 3, 4)) :: local4
      type(dType(1, 9, 3, 4)) :: local5

      arg2 = arg3
      arg2 = local1
      arg3 = local1
      local1 = local2
      local2 = local3
      !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=2_4,k2=4_4,l1=9_4,l2=3_4))
      local1 = local4 ! mismatched constant KIND type parameter
      !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(dtype(k1=2_4,k2=4_4,l1=1_4,l2=3_4)) and TYPE(dtype(k1=9_4,k2=4_4,l1=1_4,l2=3_4))
      local1 = local5 ! mismatched constant LEN type parameter
    end subroutine sub
end subroutine s12

subroutine s13()
  interface assignment(=)
    procedure :: cToR, cToRa, cToI
  end interface
  real :: x(1)
  integer :: n(1)
  x='0' ! fine
  n='0' ! fine
  !ERROR: Defined assignment in WHERE must be elemental, but 'ctora' is not
  where ([1==1]) x='*'
  where ([1==1]) n='*' ! fine
  forall (j=1:1)
    !ERROR: The mask or variable must not be scalar
    where (j==1)
      !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
      !ERROR: The mask or variable must not be scalar
      x(j)='?'
      !ERROR: The mask or variable must not be scalar
      n(j)='?'
    !ERROR: The mask or variable must not be scalar
    elsewhere (.false.)
      !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
      !ERROR: The mask or variable must not be scalar
      x(j)='1'
      !ERROR: The mask or variable must not be scalar
      n(j)='1'
    elsewhere
      !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
      !ERROR: The mask or variable must not be scalar
      x(j)='9'
      !ERROR: The mask or variable must not be scalar
      n(j)='9'
    end where
  end forall
  x='0' ! still fine
  n='0' ! still fine
 contains
  subroutine cToR(x, c)
    real, intent(out) :: x
    character, intent(in) :: c
  end subroutine
  subroutine cToRa(x, c)
    real, intent(out) :: x(:)
    character, intent(in) :: c
  end subroutine
  elemental subroutine cToI(n, c)
    integer, intent(out) :: n
    character, intent(in) :: c
  end subroutine
end subroutine s13

module m14
  type t1
    integer, pointer :: p
   contains
    procedure definedAsst1
    generic :: assignment(=) => definedAsst1
  end type
  type t2
    integer, pointer :: p
  end type
  interface assignment(=)
    module procedure definedAsst2
  end interface
  type t3
    integer, pointer :: p
  end type
 contains
  pure subroutine definedAsst1(lhs,rhs)
    class(t1), intent(in out) :: lhs
    class(t1), intent(in) :: rhs
  end subroutine
  pure subroutine definedAsst2(lhs,rhs)
    type(t2), intent(out) :: lhs
    type(t2), intent(in) :: rhs
  end subroutine
  pure subroutine test(y1,y2,y3)
    type(t1) x1
    type(t1), intent(in) :: y1
    type(t2) x2
    type(t2), intent(in) :: y2
    type(t3) x3
    type(t3), intent(in) :: y3
    x1 = y1 ! fine due to not being intrinsic assignment
    x2 = y2 ! fine due to not being intrinsic assignment
    !ERROR: A pure subprogram may not copy the value of 'y3' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%p'
    x3 = y3
  end subroutine
end module m14