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