Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/assumed_rank_2.f90 @ 132:d34655255c78
update gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 10:21:07 +0900 |
parents | 84e7813d76e9 |
children |
comparison
equal
deleted
inserted
replaced
130:e108057fa461 | 132:d34655255c78 |
---|---|
14 integer, allocatable :: val(:) | 14 integer, allocatable :: val(:) |
15 integer :: i | 15 integer :: i |
16 | 16 |
17 allocate(z(1:4, -2:5, 4, 10:11)) | 17 allocate(z(1:4, -2:5, 4, 10:11)) |
18 | 18 |
19 if (rank(x) /= 2) call abort () | 19 if (rank(x) /= 2) STOP 1 |
20 val = [(2*i+3, i = 1, size(x))] | 20 val = [(2*i+3, i = 1, size(x))] |
21 x = reshape (val, shape(x)) | 21 x = reshape (val, shape(x)) |
22 call foo(x, rank(x), lbound(x), ubound(x), val) | 22 call foo(x, rank(x), lbound(x), ubound(x), val) |
23 call foo2(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.) | 24 call bar(x,x,.true.) |
25 call bar(x,prsnt=.false.) | 25 call bar(x,prsnt=.false.) |
26 | 26 |
27 if (rank(y) /= 1) call abort () | 27 if (rank(y) /= 1) STOP 2 |
28 val = [(2*i+7, i = 1, size(y))] | 28 val = [(2*i+7, i = 1, size(y))] |
29 y = reshape (val, shape(y)) | 29 y = reshape (val, shape(y)) |
30 call foo(y, rank(y), lbound(y), ubound(y), val) | 30 call foo(y, rank(y), lbound(y), ubound(y), val) |
31 call foo2(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.) | 32 call bar(y,y,.true.) |
33 call bar(y,prsnt=.false.) | 33 call bar(y,prsnt=.false.) |
34 | 34 |
35 if (rank(z) /= 4) call abort () | 35 if (rank(z) /= 4) STOP 3 |
36 val = [(2*i+5, i = 1, size(z))] | 36 val = [(2*i+5, i = 1, size(z))] |
37 z(:,:,:,:) = reshape (val, shape(z)) | 37 z(:,:,:,:) = reshape (val, shape(z)) |
38 call foo(z, rank(z), lbound(z), ubound(z), val) | 38 call foo(z, rank(z), lbound(z), ubound(z), val) |
39 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) | 40 call foo2(z, rank(z), lbound(z), ubound(z), val) |
43 | 43 |
44 contains | 44 contains |
45 subroutine bar(a,b, prsnt) | 45 subroutine bar(a,b, prsnt) |
46 integer, pointer, optional, intent(in) :: a(..),b(..) | 46 integer, pointer, optional, intent(in) :: a(..),b(..) |
47 logical, value :: prsnt | 47 logical, value :: prsnt |
48 if (.not. associated(a)) call abort() | 48 if (.not. associated(a)) STOP 4 |
49 if (present(b)) then | 49 if (present(b)) then |
50 ! The following is not valid | 50 ! The following is not valid |
51 ! Technically, it could be allowed and might be in Fortran 2015: | 51 ! Technically, it could be allowed and might be in Fortran 2015: |
52 ! if (.not. associated(a,b)) call abort() | 52 ! if (.not. associated(a,b)) STOP 5 |
53 else | 53 else |
54 if (.not. associated(a)) call abort() | 54 if (.not. associated(a)) STOP 6 |
55 end if | 55 end if |
56 if (.not. present(a)) call abort() | 56 if (.not. present(a)) STOP 7 |
57 if (prsnt .neqv. present(b)) call abort() | 57 if (prsnt .neqv. present(b)) STOP 8 |
58 end subroutine | 58 end subroutine |
59 | 59 |
60 ! POINTER argument - bounds as specified before | 60 ! POINTER argument - bounds as specified before |
61 subroutine foo(a, rnk, low, high, val) | 61 subroutine foo(a, rnk, low, high, val) |
62 integer,pointer, intent(in) :: a(..) | 62 integer,pointer, intent(in) :: a(..) |
64 integer, intent(in) :: low(:), high(:), val(:) | 64 integer, intent(in) :: low(:), high(:), val(:) |
65 integer :: i | 65 integer :: i |
66 | 66 |
67 | 67 |
68 | 68 |
69 if (rank(a) /= rnk) call abort() | 69 if (rank(a) /= rnk) STOP 9 |
70 if (size(low) /= rnk .or. size(high) /= rnk) call abort() | 70 if (size(low) /= rnk .or. size(high) /= rnk) STOP 10 |
71 if (size(a) /= product (high - low +1)) call abort() | 71 if (size(a) /= product (high - low +1)) STOP 11 |
72 | 72 |
73 if (rnk > 0) then | 73 if (rnk > 0) then |
74 if (low(1) /= lbound(a,1)) call abort() | 74 if (low(1) /= lbound(a,1)) STOP 12 |
75 if (high(1) /= ubound(a,1)) call abort() | 75 if (high(1) /= ubound(a,1)) STOP 13 |
76 if (size (a,1) /= high(1)-low(1)+1) call abort() | 76 if (size (a,1) /= high(1)-low(1)+1) STOP 14 |
77 end if | 77 end if |
78 | 78 |
79 do i = 1, rnk | 79 do i = 1, rnk |
80 if (low(i) /= lbound(a,i)) call abort() | 80 if (low(i) /= lbound(a,i)) STOP 15 |
81 if (high(i) /= ubound(a,i)) call abort() | 81 if (high(i) /= ubound(a,i)) STOP 16 |
82 if (size (a,i) /= high(i)-low(i)+1) call abort() | 82 if (size (a,i) /= high(i)-low(i)+1) STOP 17 |
83 end do | 83 end do |
84 call foo2(a, rnk, low, high, val) | 84 call foo2(a, rnk, low, high, val) |
85 end subroutine | 85 end subroutine |
86 | 86 |
87 ! Non-pointer, non-allocatable bounds. lbound == 1 | 87 ! Non-pointer, non-allocatable bounds. lbound == 1 |
89 integer, intent(in) :: a(..) | 89 integer, intent(in) :: a(..) |
90 integer, value :: rnk | 90 integer, value :: rnk |
91 integer, intent(in) :: low(:), high(:), val(:) | 91 integer, intent(in) :: low(:), high(:), val(:) |
92 integer :: i | 92 integer :: i |
93 | 93 |
94 if (rank(a) /= rnk) call abort() | 94 if (rank(a) /= rnk) STOP 18 |
95 if (size(low) /= rnk .or. size(high) /= rnk) call abort() | 95 if (size(low) /= rnk .or. size(high) /= rnk) STOP 19 |
96 if (size(a) /= product (high - low +1)) call abort() | 96 if (size(a) /= product (high - low +1)) STOP 20 |
97 | 97 |
98 if (rnk > 0) then | 98 if (rnk > 0) then |
99 if (1 /= lbound(a,1)) call abort() | 99 if (1 /= lbound(a,1)) STOP 21 |
100 if (high(1)-low(1)+1 /= ubound(a,1)) call abort() | 100 if (high(1)-low(1)+1 /= ubound(a,1)) STOP 22 |
101 if (size (a,1) /= high(1)-low(1)+1) call abort() | 101 if (size (a,1) /= high(1)-low(1)+1) STOP 23 |
102 end if | 102 end if |
103 | 103 |
104 do i = 1, rnk | 104 do i = 1, rnk |
105 if (1 /= lbound(a,i)) call abort() | 105 if (1 /= lbound(a,i)) STOP 24 |
106 if (high(i)-low(i)+1 /= ubound(a,i)) call abort() | 106 if (high(i)-low(i)+1 /= ubound(a,i)) STOP 25 |
107 if (size (a,i) /= high(i)-low(i)+1) call abort() | 107 if (size (a,i) /= high(i)-low(i)+1) STOP 26 |
108 end do | 108 end do |
109 end subroutine foo2 | 109 end subroutine foo2 |
110 | 110 |
111 ! ALLOCATABLE argument - bounds as specified before | 111 ! ALLOCATABLE argument - bounds as specified before |
112 subroutine foo3 (a, rnk, low, high, val) | 112 subroutine foo3 (a, rnk, low, high, val) |
113 integer, allocatable, intent(in), target :: a(..) | 113 integer, allocatable, intent(in), target :: a(..) |
114 integer, value :: rnk | 114 integer, value :: rnk |
115 integer, intent(in) :: low(:), high(:), val(:) | 115 integer, intent(in) :: low(:), high(:), val(:) |
116 integer :: i | 116 integer :: i |
117 | 117 |
118 if (rank(a) /= rnk) call abort() | 118 if (rank(a) /= rnk) STOP 27 |
119 if (size(low) /= rnk .or. size(high) /= rnk) call abort() | 119 if (size(low) /= rnk .or. size(high) /= rnk) STOP 28 |
120 if (size(a) /= product (high - low +1)) call abort() | 120 if (size(a) /= product (high - low +1)) STOP 29 |
121 | 121 |
122 if (rnk > 0) then | 122 if (rnk > 0) then |
123 if (low(1) /= lbound(a,1)) call abort() | 123 if (low(1) /= lbound(a,1)) STOP 30 |
124 if (high(1) /= ubound(a,1)) call abort() | 124 if (high(1) /= ubound(a,1)) STOP 31 |
125 if (size (a,1) /= high(1)-low(1)+1) call abort() | 125 if (size (a,1) /= high(1)-low(1)+1) STOP 32 |
126 end if | 126 end if |
127 | 127 |
128 do i = 1, rnk | 128 do i = 1, rnk |
129 if (low(i) /= lbound(a,i)) call abort() | 129 if (low(i) /= lbound(a,i)) STOP 33 |
130 if (high(i) /= ubound(a,i)) call abort() | 130 if (high(i) /= ubound(a,i)) STOP 34 |
131 if (size (a,i) /= high(i)-low(i)+1) call abort() | 131 if (size (a,i) /= high(i)-low(i)+1) STOP 35 |
132 end do | 132 end do |
133 call foo(a, rnk, low, high, val) | 133 call foo(a, rnk, low, high, val) |
134 end subroutine | 134 end subroutine |
135 end | 135 end |