3 ! Test the behavior of lbound, ubound of shape with assumed rank arguments
4 ! in an array context (without DIM argument).
10 integer, allocatable
:: b(:,:)
11 integer, pointer :: c(:,:)
12 character(52) :: buffer
29 !print *, id(lbound(arg))
30 if (any(lbound(arg
) /= [1, 1])) call abort
31 if (any(id(lbound(arg
)) /= [1, 1])) call abort
32 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
33 write(buffer
,*) lbound(arg
)
34 if (buffer
/= ' 1 1') call abort
35 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
36 write(buffer
,*) id(lbound(arg
))
37 if (buffer
/= ' 1 1') call abort
40 !print *, id(ubound(arg))
41 if (any(ubound(arg
) /= [3, 8])) call abort
42 if (any(id(ubound(arg
)) /= [3, 8])) call abort
43 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
44 write(buffer
,*) ubound(arg
)
45 if (buffer
/= ' 3 8') call abort
46 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
47 write(buffer
,*) id(ubound(arg
))
48 if (buffer
/= ' 3 8') call abort
51 !print *, id(shape(arg))
52 if (any(shape(arg
) /= [3, 8])) call abort
53 if (any(id(shape(arg
)) /= [3, 8])) call abort
54 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
55 write(buffer
,*) shape(arg
)
56 if (buffer
/= ' 3 8') call abort
57 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
58 write(buffer
,*) id(shape(arg
))
59 if (buffer
/= ' 3 8') call abort
63 integer, allocatable
:: arg(:,:)
66 !print *, id(lbound(arg))
67 if (any(lbound(arg
) /= [2, -2])) call abort
68 if (any(id(lbound(arg
)) /= [2, -2])) call abort
69 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
70 write(buffer
,*) lbound(arg
)
71 if (buffer
/= ' 2 -2') call abort
72 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
73 write(buffer
,*) id(lbound(arg
))
74 if (buffer
/= ' 2 -2') call abort
77 !print *, id(ubound(arg))
78 if (any(ubound(arg
) /= [4, 5])) call abort
79 if (any(id(ubound(arg
)) /= [4, 5])) call abort
80 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
81 write(buffer
,*) ubound(arg
)
82 if (buffer
/= ' 4 5') call abort
83 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
84 write(buffer
,*) id(ubound(arg
))
85 if (buffer
/= ' 4 5') call abort
88 !print *, id(shape(arg))
89 if (any(shape(arg
) /= [3, 8])) call abort
90 if (any(id(shape(arg
)) /= [3, 8])) call abort
91 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
92 write(buffer
,*) shape(arg
)
93 if (buffer
/= ' 3 8') call abort
94 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
95 write(buffer
,*) id(shape(arg
))
96 if (buffer
/= ' 3 8') call abort
100 integer, pointer :: arg(..)
102 !print *, lbound(arg)
103 !print *, id(lbound(arg))
104 if (any(lbound(arg
) /= [2, -2])) call abort
105 if (any(id(lbound(arg
)) /= [2, -2])) call abort
106 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
107 write(buffer
,*) lbound(arg
)
108 if (buffer
/= ' 2 -2') call abort
109 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
110 write(buffer
,*) id(lbound(arg
))
111 if (buffer
/= ' 2 -2') call abort
113 !print *, ubound(arg)
114 !print *, id(ubound(arg))
115 if (any(ubound(arg
) /= [4, 5])) call abort
116 if (any(id(ubound(arg
)) /= [4, 5])) call abort
117 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
118 write(buffer
,*) ubound(arg
)
119 if (buffer
/= ' 4 5') call abort
120 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
121 write(buffer
,*) id(ubound(arg
))
122 if (buffer
/= ' 4 5') call abort
125 !print *, id(shape(arg))
126 if (any(shape(arg
) /= [3, 8])) call abort
127 if (any(id(shape(arg
)) /= [3, 8])) call abort
128 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
129 write(buffer
,*) shape(arg
)
130 if (buffer
/= ' 3 8') call abort
131 buffer
= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'
132 write(buffer
,*) id(shape(arg
))
133 if (buffer
/= ' 3 8') call abort
136 elemental
function id(arg
)
137 integer, intent(in
) :: arg