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