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
|
! passing array as function arguments (with unknown size at compile time)
! Testing for both interfaces and functions
MODULE passing_array_01_mod
implicit none
INTERFACE test_01_interface
MODULE PROCEDURE test_01
END INTERFACE test_01_interface
INTERFACE test_02_interface
MODULE PROCEDURE test_02
END INTERFACE test_02_interface
INTERFACE test_03_interface
MODULE PROCEDURE test_03
END INTERFACE test_03_interface
CONTAINS
pure FUNCTION func() result (x)
integer :: x
x = 10
end FUNCTION func
! Array dimension is call to function
FUNCTION test_01 (len,value) result(res)
implicit none
integer ,intent(in):: len
INTEGER, DIMENSION(func()),intent(in) :: value
integer:: res
res = size(value)
END FUNCTION test_01
! Array dimension is Variable
FUNCTION test_02 (len,value) result(res)
implicit none
integer ,intent(inout):: len
INTEGER, DIMENSION(len),intent(in) :: value
integer:: res
res = size(value)
END FUNCTION test_02
! Array dimension is variable + function call + constant
FUNCTION test_03 (len,value) result(res)
implicit none
integer ,intent(in):: len
INTEGER, DIMENSION(len + func() + 10),intent(in) :: value
integer:: res
res = size(value)
END FUNCTION test_03
SUBROUTINE test_entry
implicit none
INTEGER :: len
INTEGER, DIMENSION(6) :: arr
INTEGER :: ret
len = 20
arr = [1,2,3,4,5,6]
! All calls would accept the passed array,
! as they don't have compile-time array size to compare against.
ret = test_01_interface (len,arr)
print * , ret
if (ret /= 10) error stop
ret = test_01 (len,arr)
print * , ret
if (ret /= 10) error stop
ret = test_02_interface (len,arr)
print * , ret
if (ret /= 20) error stop
ret = test_02 (len,arr)
print * , ret
if (ret /= 20) error stop
ret = test_03_interface (len,arr)
print * , ret
if (ret /= 40) error stop
ret = test_03 (len,arr)
print * , ret
if (ret /= 40) error stop
END SUBROUTINE test_entry
END MODULE passing_array_01_mod
program passing_array_01
use passing_array_01_mod
implicit none
call test_entry
end program passing_array_01
|
