File: continue_compilation_2.f90

package info (click to toggle)
lfortran 0.58.0-6
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 54,512 kB
  • sloc: cpp: 162,179; f90: 68,251; python: 17,476; ansic: 6,278; yacc: 2,334; sh: 1,317; fortran: 892; makefile: 37; javascript: 15
file content (471 lines) | stat: -rw-r--r-- 12,413 bytes parent folder | download
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
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
module Geometry
    implicit none

    type :: Circle
        real :: radius
contains
    procedure :: calculateArea
    end type Circle

contains

    ! Type-bound subroutine to calculate the area of a circle
    subroutine calculateArea(self, area)
       class(Circle), intent(in) :: self
       real, intent(out) :: area
       area = 3.14 * self%radius**2
    end subroutine calculateArea
end module Geometry

module my_module
    integer :: x = 10
end module wrong_module_name

subroutine myname
end subroutine myname

block data myname
end block data myname

module continue_compilation_2_mod
    contains

    subroutine solsy ()
        double precision rowns(209)
        common /rowns/ rowns(209)
        print *, set_exponent([1, 2, 3], 2)
    end
    
    subroutine try_to_change(y)
        integer, intent(in) :: y
        y = 99  
    end subroutine

    subroutine my_subroutine1()
        print *, "Inside subroutine"
    end subroutine different_name

    function my_function() result(res)
        integer :: res
        res = 42
    end function not_my_function

    subroutine my_subroutine2()
        print *, "Inside subroutine"
    end subroutine different_name 

    SUBROUTINE faulty_subroutine(a, b, c)
        INTEGER, INTENT(IN) :: sub_a
    END SUBROUTINE faulty_subroutine

    subroutine sub_a(val_a)
        integer, intent(in) :: val_a
        call sub_b(val_a)
    end subroutine sub_a

    subroutine sub_b(val_b)
        integer, intent(inout) :: val_b
    end subroutine sub_b

    function outer_func(val_a) result(res)
        integer, intent(in) :: val_a
        integer :: res
        res = inner_func(val_a)
    end function outer_func

    function inner_func(val_b) result(res)
        integer, intent(inout) :: val_b
        integer :: res
    end function inner_func

    subroutine arank(x)
        integer :: x(.., 5)
    end subroutine arank


    
end module continue_compilation_2_mod



! Only put declarations and statements here, no subroutines (those go above).
program continue_compilation_2
    use continue_compilation_2_mod
    use iso_fortran_env
    use iso_c_binding, only: c_ptr, c_f_pointer
    use Geometry
    implicit real(a-z)

    ! Put declarations below without empty lines
    integer, pointer, parameter :: v => null()
    integer, allocatable, parameter :: v=1
    integer init_x = 1

    ! Variable declarations 
    type(c_ptr) :: queries_1
    integer, pointer :: y_1
    type(c_ptr) :: queries_2
    integer(2), pointer :: y_2(:)
    integer :: shape(2, 2)
    integer, parameter :: x = 2
    type(Circle) :: myCircle
    real :: circleArea
    complex :: a
    integer :: val
    character(1) :: x_2
    integer :: i
    integer :: a_2(3)
    integer :: size_a
    integer :: a_3(3)
    integer :: size_a_2
    integer :: kindvar = 4
    integer :: atom[*]
    real(8), allocatable :: x_3(:)
    real :: y_3
    integer, parameter :: Nx = 600, Ny = 450
    integer :: i_1, j, image(Nx, Ny)
    integer :: i_2, j_1
    integer :: i_3
    complex :: a_4
    complex :: a_5
    real :: y_4
    integer :: idaa2_x(1:2,1:2,1:2)
    integer :: idaa2_y(1:2,1:2,1:1)
    logical, parameter :: idlalb1_x(3) = [.true., .false., .false.]
    logical, parameter :: idlalb2_x1(3) = [.true., .false., .false.]
    logical, parameter :: idlalb2_x2(2) = [.true., .true.]
    integer, allocatable :: iraa1_arr1(:, :)
    integer, allocatable :: iraa2_arr1(:, :, :)
    integer, allocatable :: iraa2_arr3(:)
    integer :: iatw1_b(5)
    integer :: iatw2_i1(5)
    integer :: iatw2_b(5)
    integer  :: itw1_b(5)
    integer  :: itw2_b(5)
    integer  :: itw3_b(5)
    INTEGER :: intent_x
    real(8) :: intr2_x, intr2_y, datan2
    integer(4) :: intr8_x = 1
    integer(8) :: intr8_y = 2
    integer(4) :: intr9_x = 1
    integer(8) :: intr9_y = 2
    integer(4) :: intr10_x = 1
    integer(8) :: intr10_y = 2
    integer, parameter :: ici_ios = 1
    character(len=100) :: ici_buffer
    integer :: insv_ios(2) = 1
    character(len=100) :: insv_buffer
    complex :: complex_z = (1, 2)
    integer :: tm1_x
    integer :: tm2_x
    !int_01_1.f90
    integer(8), parameter :: ar1(3) = int([1, 2, 3], [8, 8, 8])
    !int_01_2.f90
    integer(8), parameter :: ar2(3) = int([1, 2, 3], [8, 8, 8])
    !kind_invalid_float_of_int
    integer(4.2) :: ifoix
    !kind_invalid_int_of_complex
    complex(6) :: iiocx
    !kind_invalid_int_of_int
    integer(3) :: iifix
    !kind_invalid_int_of_logical
    logical(10) :: iiolx
    !kind_star_of_complex
    complex(*) :: ksoca
    !kind_star_of_int
    integer(*) :: ksoia
    !kind_star_of_logical
    logical(*) :: ksola
    !kind_string_of_int
    integer('a') :: ksoix
    !kind_var_of_int
    integer :: kvoia = 4
    real(kvoia) :: kvoix
    !kind1
    real(3) :: x
    !kind2
    real(*) kind2_a
    !type_conflict1
    integer, parameter, target :: foo=4
    integer :: x_bad_implicit
    !unsupported kind
    real*16 :: unsupported_kind
    ! argument not specified
    type(Circle) :: myCircle2 = Circle()
    ! invalid keyword argument specified
    type(Circle) :: myCircle3 = Circle(mykeyword=10)
    !tokenizer error
    integer  :: ? tokenizer_error
    integer, dimension(3,2) :: m = [ 1, 0, 0, 2, 4, 6 ]
    real :: idint_kind_mismatch = 4.23
    character(5):: ichar_runtime = "Hello"
    real(8) :: dprod_1, dprod_2
    real(4) :: dprod_3 = 4.23
    real(4) ::idnint_runtime = 3.5
    real(8) :: ifix_runtime = 4.23
    logical :: min_max = .true.
    integer :: intent_bug_sub_x = 10
    character(len=2) :: lhs
    type string_t
        character(:), allocatable :: value
    end type string_t
    character :: rhs(2)
    type(string_t) :: str_t_1, str_t_2
    character(len=10) :: prefix
    integer :: aRank1(..)
    character(:), ALLOCATABLE :: str1















    allocate(str1(i))
    str_t_1%value = "world!"
    prefix = "hello, "
    str_t_2 = prefix // 10
    str_t_2 = prefix // str_t_1
    ! c_f_pointer_01
    call c_f_pointer(queries_1, y_1, [2])
    ! c_f_pointer_02
    call c_f_pointer(queries_2, y_2, shape)
    ! assign_01
    x = 1
    ! class_procedure_extra_args
    myCircle%radius = 5.0
    call myCircle%calculateArea(circleArea, 12)
    ! close_invalid_kwarg1
    CLOSE(end=200)
    ! cmplx_01
    print *, cmplx(y = 2) ! a = cmplx(y = 2) ! does not work with continue compilation
    ! cmplx_02
    print*, cmplx((real(1, kind=4), 0.00000000), kind=8)
    ! cmplx_03
    print*, cmplx((1.00000000, real(0, kind=4)), kind=8)
    ! coarray_01
    val = this_image ()
    call co_sum (val, result_image=1)
    if (this_image() == 1) then
      write(*,*) "The sum is ", val                                
    end if
    ! coarray_02
    call event_query(1, 1, 1)
    ! compare_01
    x_2 = 'u'
    i = 10
    if (i > x_2) then
    else
    end if
    !array_size_02
    size_a = size(a_2, 1, dim=1)
    size_a = size(a_2, dim = 1, 1)
    !array_size_05
    size_a_2 = size(a_3, kind=kindvar, dim=1)
    size_a_2 = size(a_3, kind=kindvar)
    !atomic_01
    call atomic_add (atom[1], this_image())
    call atomic_add (atom[2], this_image())
    !array_constructor_with_asterisk_in_type_spec
    print *, [character(*) :: "a", "b", "ball", "cat"]
    !array_constructor_with_different_char_length
    print *, ["a", "b", "ball", "cat"]
    print *, ["a1", "b1", "ball1", "cat1"]
    !array_constructor_with_different_kind
    allocate(x_3(4))
    print *, [x_3, [1., 2.]]
    !array_constructor_with_different_types
    print *, [1, 2.]
    !array_constructor_with_integer_real_array_types
    print *, [1, [1., 2.]]
    !dfloat1
    print *, dfloat(y_3)
    !dim_float_01
    print *, sum([1, 2, 3], 1.1)
    !dim_float_02
    print *, sum([1, 2, 3], 1, 1.1)
    !dim_float_03
    print *, sum([1, 2, 3], .true., 1.1)
    !dint_args
    print*, dint(1.0_8, 8)
    if (abs(dint(1.0_8, 8) - 1.0_8) > 10e-5 ) error stop
    !dlgama
    print *, dlgama(2.7)
    !dnint_args
    print*, dnint(1.0_8, 8)
    if (abs(dnint(1.0_8, 8) - 1.0_8) > 10e-5 ) error stop
    !do_concurrent_01
    do concurrent (j = 1:Ny) local(i_1, j)
        do i_1 = 1, Nx
        end do
    end do
    !do_loop_01
    do i_2 = 1, 10
        do j_1 = 1, 2
        i_2 = j_1 + 1
        end do
        j_1 = i_2 + 1
        print *, i_2, j_1
    end do
    !do_zero_increment
    do i_2 = 1, 5, 0
        write(*,*) i_3
    end do
    !dprod
    print*, dprod(4.23_8, 4.3_8)
    !dreal_arg_error
    a_4 = (1.0, 2.0)
    print *, dreal(a_4)
    !fixed_number_of_args
    a_5 = complex(1)
    !float1
    print *, float(y_4)
    !flush_invalid_kwarg
    FLUSH(unit=10, start=100)
    !func_parameter_type
    print *, f(42.9)
    !ichar_01
    print*, ichar("okay")
    !idint_real4
    print *, idint(4.5)
    !ifix_01
    print *, ifix(4.23_8)
    !incompatible_dimension_assignment_arr1
    integer :: arr1(1)
    arr1 = [1, 2, 3]
    !incompatible_dimension_assignment_arr2
    idaa2_x = reshape([1, 2, 3, 4, 5, 6, 7, 8], [2, 2, 2])
    idaa2_y = reshape([1, 2, 3, 4], [2, 2, 1])
    idaa2_y = idaa2_x
    !incompatible_dimension_logical_arrays_logical_binop_01
    print *, idlalb1_x .neqv. [.true., .true.]
    !incompatible_dimension_logical_arrays_logical_binop_02
    print *, idlalb2_x1 .neqv. idlalb2_x2
    !incompatible_rank_allocatable_arr1
    iraa1_arr1 = [1, 2, 3]
    !incompatible_rank_allocatable_arr2
    iraa2_arr3 = iraa2_arr1
    !incorrect_array_type_where_01
    where([1, 2, 3, 4, 5]) iatw1_b = 1
    print *, iatw1_b
    if (all(iatw1_b /= [1, 0, 1, 0, 1])) error stop
    !incorrect_array_type_where_02
    iatw2_i1 = [1, 2, 3, 4, 5]
    where(iatw2_i1) iatw2_b = 1
    print *, iatw2_b
    if (all(iatw2_b /= [1, 0, 1, 0, 1])) error stop
    !incorrect_type_where_01
    where(.true.) itw1_b = 12121
    print *, itw1_b
    !incorrect_type_where_02
    where(1) itw2_b = 12121
    print *, itw2_b
    !incorrect_type_where_03
    where(max(1.33, 2.67)) itw3_b = 12121
    print *, itw3_b
    !intent1
    intent_x = 42
    CALL try_to_change(intent_x)
    !intrinsics1
    print *, radix((2.4, 1.0))
    !intrinsics2
    intr2_x = 2.33D0
    intr2_y = 3.41D0
    print *, datan2(x,y)
    if(abs(datan2(x,y) - 0.59941916594660438) > 1d-6) error stop
    !intrinsics3
    print *, ibclr(1, -2)
    !intrinsics4
    print *, dshiftl(1, 1_8, 1)
    !intrinsics5
    print *, ior(1, 1_8)
    !intrinsics6
    print *, ieor(1, 1_8)
    !intrinsics7
    print *, hypot(1.0, 2.7_8)
    !intrinsics8
    print *, ior(intr8_x, intr8_y)
    !intrinsics9
    print *, iand(intr9_x, intr9_y)
    !intrinsics10
    print *, ieor(intr10_x, intr10_y)
    !intrinsics11
    real(4) :: intr11_x = 1
    real(8) :: intr11_y = 2
    print *, hypot(intr11_x, intr11_y)
    !intrinsics12
    print *, max(12, 13.94)
    !intrinsics13
    print *, min(12, 13.94)
    !intrinsics14
    print *, scale([1, 2, 3], 2)
    !intrinsics15
    print *, set_exponent([1, 2, 3], 2)
    !iostat_constant_integer
    ici_buffer = 'Temporary date for testing purpose'
    read(ici_buffer, *, iostat=ici_ios)
    !iostat_non_scalar_value
    insv_buffer = 'Temporary date for testing purpose'
    read(insv_buffer, *, iostat=insv_ios(1:1))
    !ishftc_size
    print *, ishftc(10, 6, 4)
    !complex_01
    print *, cmplx(complex_z , 1)
    !kind_01
    print *, aint([1.0, 2.0, 3.0], [4, 4])
    !type_mismatch_1
    tm1_x = "x"
    !type_mismatch_2
    tm2_x = 5 + "x"

    print *,foo
    x_bad_implicit = 10
    print *, x_bad_implicit

    ! member not found
    print *, myCircle%mymember

    100 FORMAT(A10, @)

    print*, merge("okay", "ok", .true.)
    !idint_kind_mismatch
    print *, idint(4.23)
    print *, idint(idint_kind_mismatch)
    !ichar_runtime
    print *, ichar(ichar_runtime)
    !dprod_runtime
    print *, dprod(dprod_1, dprod_2)
    print *, dprod(dprod_3, dprod_2)
    !idnint
    print *, idnint(3.5)
    print *, idnint(idnint_runtime)
    !ifix
    print *, ifix(4.23_8)
    print *, ifix(ifix_runtime)
    !min
    print *, min(.true., .false.)
    print *, min(min_max, min_max)
    !max
    print *, max(.true., .false.)
    print *, max(min_max, min_max)
    !nested intent
    call sub_a(intent_bug_sub_x)
    print *, outer_func(intent_bug_sub_x)
    !size_intrinsic_check
    print *, size(ichar_runtime)
    lhs = rhs
    contains
    logical function f(x)
        integer, intent(in), optional :: x
        f = PRESENT(x)
    end function

end program