Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/assumed_rank_2.f90 @ 132:d34655255c78

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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