|
111
|
1 ! { dg-do run }
|
|
|
2 !
|
|
|
3 ! Test the behavior of lbound, ubound of shape with assumed rank arguments
|
|
|
4 ! in an array context (without DIM argument).
|
|
|
5 !
|
|
|
6
|
|
|
7 program test
|
|
|
8
|
|
|
9 integer :: a(2:4,-2:5)
|
|
|
10 integer, allocatable :: b(:,:)
|
|
|
11 integer, allocatable :: c(:,:)
|
|
|
12 integer, pointer :: d(:,:)
|
|
|
13 character(52) :: buffer
|
|
|
14
|
|
|
15 b = foo(a)
|
|
|
16 !print *,b(:,1)
|
|
131
|
17 if (any(b(:,1) /= [11, 101])) STOP 1
|
|
111
|
18 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
19 write(buffer,*) b(:,1)
|
|
131
|
20 if (buffer /= ' 11 101') STOP 2
|
|
111
|
21
|
|
|
22 !print *,b(:,2)
|
|
131
|
23 if (any(b(:,2) /= [3, 8])) STOP 3
|
|
111
|
24 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
25 write(buffer,*) b(:,2)
|
|
131
|
26 if (buffer /= ' 3 8') STOP 4
|
|
111
|
27
|
|
|
28 !print *,b(:,3)
|
|
131
|
29 if (any(b(:,3) /= [13, 108])) STOP 5
|
|
111
|
30 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
31 write(buffer,*) b(:,3)
|
|
131
|
32 if (buffer /= ' 13 108') STOP 6
|
|
111
|
33
|
|
|
34
|
|
|
35 allocate(c(1:2,-3:6))
|
|
|
36 b = bar(c)
|
|
|
37 !print *,b(:,1)
|
|
131
|
38 if (any(b(:,1) /= [11, 97])) STOP 7
|
|
111
|
39 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
40 write(buffer,*) b(:,1)
|
|
131
|
41 if (buffer /= ' 11 97') STOP 8
|
|
111
|
42
|
|
|
43 !print *,b(:,2)
|
|
131
|
44 if (any(b(:,2) /= [12, 106])) STOP 9
|
|
111
|
45 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
46 write(buffer,*) b(:,2)
|
|
131
|
47 if (buffer /= ' 12 106') STOP 10
|
|
111
|
48
|
|
|
49 !print *,b(:,3)
|
|
131
|
50 if (any(b(:,3) /= [2, 10])) STOP 11
|
|
111
|
51 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
52 write(buffer,*) b(:,3)
|
|
131
|
53 if (buffer /= ' 2 10') STOP 12
|
|
111
|
54
|
|
|
55
|
|
|
56 allocate(d(3:5,-1:10))
|
|
|
57 b = baz(d)
|
|
|
58 !print *,b(:,1)
|
|
131
|
59 if (any(b(:,1) /= [3, -1])) STOP 13
|
|
111
|
60 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
61 write(buffer,*) b(:,1)
|
|
131
|
62 if (buffer /= ' 3 -1') STOP 14
|
|
111
|
63
|
|
|
64 !print *,b(:,2)
|
|
131
|
65 if (any(b(:,2) /= [15, 110])) STOP 15
|
|
111
|
66 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
67 write(buffer,*) b(:,2)
|
|
131
|
68 if (buffer /= ' 15 110') STOP 16
|
|
111
|
69
|
|
|
70 !print *,b(:,3)
|
|
131
|
71 if (any(b(:,3) /= [13, 112])) STOP 17
|
|
111
|
72 buffer = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
|
|
|
73 write(buffer,*) b(:,3)
|
|
131
|
74 if (buffer /= ' 13 112') STOP 18
|
|
111
|
75
|
|
|
76
|
|
|
77 contains
|
|
|
78 function foo(arg) result(res)
|
|
|
79 integer :: arg(..)
|
|
|
80 integer, allocatable :: res(:,:)
|
|
|
81
|
|
|
82 allocate(res(rank(arg), 3))
|
|
|
83
|
|
|
84 res(:,1) = lbound(arg) + (/ 10, 100 /)
|
|
|
85 res(:,2) = ubound(arg)
|
|
|
86 res(:,3) = (/ 10, 100 /) + shape(arg)
|
|
|
87
|
|
|
88 end function foo
|
|
|
89 function bar(arg) result(res)
|
|
|
90 integer, allocatable :: arg(..)
|
|
|
91 integer, allocatable :: res(:,:)
|
|
|
92
|
|
|
93 allocate(res(-1:rank(arg)-2, 3))
|
|
|
94
|
|
|
95 res(:,1) = lbound(arg) + (/ 10, 100 /)
|
|
|
96 res(:,2) = (/ 10, 100 /) + ubound(arg)
|
|
|
97 res(:,3) = shape(arg)
|
|
|
98
|
|
|
99 end function bar
|
|
|
100 function baz(arg) result(res)
|
|
|
101 integer, pointer :: arg(..)
|
|
|
102 integer, allocatable :: res(:,:)
|
|
|
103
|
|
|
104 allocate(res(2:rank(arg)+1, 3))
|
|
|
105
|
|
|
106 res(:,1) = lbound(arg)
|
|
|
107 res(:,2) = (/ 10, 100 /) + ubound(arg)
|
|
|
108 res(:,3) = shape(arg) + (/ 10, 100 /)
|
|
|
109
|
|
|
110 end function baz
|
|
|
111 end program test
|
|
|
112
|
