1! { dg-do run }
2!
3! Test the behaviour of lbound, ubound of shape with assumed rank arguments
4! in an array context (without DIM argument).
5!
6
7program test
8
9  integer              :: a(2:4,-2:5)
10  integer, allocatable :: b(:,:)
11  integer, pointer     :: c(:,:)
12  character(52)        :: buffer
13
14  call foo(a)
15
16  allocate(b(2:4,-2:5))
17  call foo(b)
18  call bar(b)
19
20  allocate(c(2:4,-2:5))
21  call foo(c)
22  call baz(c)
23
24contains
25  subroutine foo(arg)
26    integer :: arg(..)
27
28    !print *, lbound(arg)
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
38
39    !print *, ubound(arg)
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
49
50    !print *, shape(arg)
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
60
61  end subroutine foo
62  subroutine bar(arg)
63    integer, allocatable :: arg(:,:)
64
65    !print *, lbound(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
75
76    !print *, ubound(arg)
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
86
87    !print *, shape(arg)
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
97
98  end subroutine bar
99  subroutine baz(arg)
100    integer, pointer :: arg(..)
101
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
112
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
123
124    !print *, shape(arg)
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
134
135  end subroutine baz
136  elemental function id(arg)
137    integer, intent(in) :: arg
138    integer             :: id
139
140    id = arg
141  end function id
142end program test
143
144