1! { dg-do compile } 2! { dg-options "-O1 -fpredictive-commoning -fno-tree-ch -fno-tree-dominator-opts -fno-tree-fre" } 3! 4! PR tree-optimization/88932 5! 6 7implicit none 8 9interface 10 subroutine check_value(b, n, val) 11 integer :: b(..) 12 integer, value :: n 13 integer :: val(n) 14 end subroutine 15end interface 16 17integer, target :: x(2:5,4:7), y(-4:4) 18integer, allocatable, target :: z(:,:,:,:) 19integer, allocatable :: val(:) 20integer :: i 21 22allocate(z(1:4, -2:5, 4, 10:11)) 23 24if (rank(x) /= 2) STOP 1 25val = [(2*i+3, i = 1, size(x))] 26x = reshape (val, shape(x)) 27call foo(x, rank(x), lbound(x), ubound(x), val) 28call foo2(x, rank(x), lbound(x), ubound(x), val) 29call bar(x,x,.true.) 30call bar(x,prsnt=.false.) 31 32if (rank(y) /= 1) STOP 2 33val = [(2*i+7, i = 1, size(y))] 34y = reshape (val, shape(y)) 35call foo(y, rank(y), lbound(y), ubound(y), val) 36call foo2(y, rank(y), lbound(y), ubound(y), val) 37call bar(y,y,.true.) 38call bar(y,prsnt=.false.) 39 40if (rank(z) /= 4) STOP 3 41val = [(2*i+5, i = 1, size(z))] 42z(:,:,:,:) = reshape (val, shape(z)) 43call foo(z, rank(z), lbound(z), ubound(z), val) 44call foo(z, rank(z), lbound(z), ubound(z), val) 45call foo2(z, rank(z), lbound(z), ubound(z), val) 46call bar(z,z,.true.) 47call bar(z,prsnt=.false.) 48 49contains 50 subroutine bar(a,b, prsnt) 51 integer, pointer, optional, intent(in) :: a(..),b(..) 52 logical, value :: prsnt 53 if (.not. associated(a)) STOP 4 54 if (present(b)) then 55 ! The following is not valid. 56 ! Technically, it could be allowed and might be in Fortran 2015: 57 ! if (.not. associated(a,b)) STOP 5 58 else 59 if (.not. associated(a)) STOP 6 60 end if 61 if (.not. present(a)) STOP 7 62 if (prsnt .neqv. present(b)) STOP 8 63 end subroutine 64 65 ! POINTER argument - bounds as specified before 66 subroutine foo(a, rnk, low, high, val) 67 integer,pointer, intent(in) :: a(..) 68 integer, value :: rnk 69 integer, intent(in) :: low(:), high(:), val(:) 70 integer :: i 71 72 73 74 if (rank(a) /= rnk) STOP 9 75 if (size(low) /= rnk .or. size(high) /= rnk) STOP 10 76 if (size(a) /= product (high - low +1)) STOP 11 77 78 if (rnk > 0) then 79 if (low(1) /= lbound(a,1)) STOP 12 80 if (high(1) /= ubound(a,1)) STOP 13 81 if (size (a,1) /= high(1)-low(1)+1) STOP 14 82 end if 83 84 do i = 1, rnk 85 if (low(i) /= lbound(a,i)) STOP 15 86 if (high(i) /= ubound(a,i)) STOP 16 87 if (size (a,i) /= high(i)-low(i)+1) STOP 17 88 end do 89 call check_value (a, rnk, val) 90 call foo2(a, rnk, low, high, val) 91 end subroutine 92 93 ! Non-pointer, non-allocatable bounds. lbound == 1 94 subroutine foo2(a, rnk, low, high, val) 95 integer, intent(in) :: a(..) 96 integer, value :: rnk 97 integer, intent(in) :: low(:), high(:), val(:) 98 integer :: i 99 100 if (rank(a) /= rnk) STOP 18 101 if (size(low) /= rnk .or. size(high) /= rnk) STOP 19 102 if (size(a) /= product (high - low +1)) STOP 20 103 104 if (rnk > 0) then 105 if (1 /= lbound(a,1)) STOP 21 106 if (high(1)-low(1)+1 /= ubound(a,1)) STOP 22 107 if (size (a,1) /= high(1)-low(1)+1) STOP 23 108 end if 109 110 do i = 1, rnk 111 if (1 /= lbound(a,i)) STOP 24 112 if (high(i)-low(i)+1 /= ubound(a,i)) STOP 25 113 if (size (a,i) /= high(i)-low(i)+1) STOP 26 114 end do 115 call check_value (a, rnk, val) 116 end subroutine foo2 117 118 ! ALLOCATABLE argument - bounds as specified before 119 subroutine foo3 (a, rnk, low, high, val) 120 integer, allocatable, intent(in), target :: a(..) 121 integer, value :: rnk 122 integer, intent(in) :: low(:), high(:), val(:) 123 integer :: i 124 125 if (rank(a) /= rnk) STOP 27 126 if (size(low) /= rnk .or. size(high) /= rnk) STOP 28 127 if (size(a) /= product (high - low +1)) STOP 29 128 129 if (rnk > 0) then 130 if (low(1) /= lbound(a,1)) STOP 30 131 if (high(1) /= ubound(a,1)) STOP 31 132 if (size (a,1) /= high(1)-low(1)+1) STOP 32 133 end if 134 135 do i = 1, rnk 136 if (low(i) /= lbound(a,i)) STOP 33 137 if (high(i) /= ubound(a,i)) STOP 34 138 if (size (a,i) /= high(i)-low(i)+1) STOP 35 139 end do 140 call check_value (a, rnk, val) 141 call foo(a, rnk, low, high, val) 142 end subroutine 143end 144