1! { dg-do run } 2! { dg-options "-fdump-tree-original -fdump-tree-optimized -Warray-temporaries -fbounds-check" } 3 4 implicit none 5 6 integer :: i, j 7 8 integer, parameter :: nx=3, ny=4 9 integer, parameter, dimension(nx,ny) :: p = & 10 & reshape ((/ (i**2, i=1,size(p)) /), shape(p)) 11 integer, parameter, dimension(ny,nx) :: q = & 12 & reshape ((/ (((nx*(i-1)+j)**2, i=1,ny), j=1,nx) /), (/ ny, nx /)) 13 14 integer, parameter, dimension(nx,nx) :: r = & 15 & reshape ((/ (i*i, i=1,size(r)) /), shape(r)) 16 integer, parameter, dimension(nx,nx) :: s = & 17 & reshape ((/ (((nx*(i-1)+j)**2, i=1,nx), j=1,nx) /), (/ nx, nx /)) 18 19 20 21 integer, dimension(nx,ny) :: a, b 22 integer, dimension(ny,nx) :: c 23 integer, dimension(nx,nx) :: e, f, g 24 25 character(144) :: u, v 26 27 a = p 28 29 c = transpose(a) 30 if (any(c /= q)) call abort 31 32 write(u,*) transpose(a) 33 write(v,*) q 34 if (u /= v) call abort 35 36 37 e = r 38 f = s 39 40 g = transpose(e+f) 41 if (any(g /= r + s)) call abort 42 43 write(u,*) transpose(e+f) 44 write(v,*) r + s 45 if (u /= v) call abort 46 47 48 e = transpose(e) ! { dg-warning "Creating array temporary" } 49 if (any(e /= s)) call abort 50 51 write(u,*) transpose(transpose(e)) 52 write(v,*) s 53 if (u /= v) call abort 54 55 56 e = transpose(e+f) ! { dg-warning "Creating array temporary" } 57 if (any(e /= 2*r)) call abort 58 59 write(u,*) transpose(transpose(e+f))-f 60 write(v,*) 2*r 61 if (u /= v) call abort 62 63 64 a = foo(transpose(c)) 65 if (any(a /= p+1)) call abort 66 67 write(u,*) foo(transpose(c)) ! { dg-warning "Creating array temporary" } 68 write(v,*) p+1 69 if (u /= v) call abort 70 71 72 c = transpose(foo(a)) ! Unnecessary { dg-warning "Creating array temporary" } 73 if (any(c /= q+2)) call abort 74 75 write(u,*) transpose(foo(a)) ! { dg-warning "Creating array temporary" } 76 write(v,*) q+2 77 if (u /= v) call abort 78 79 80 e = foo(transpose(e)) ! { dg-warning "Creating array temporary" } 81 if (any(e /= 2*s+1)) call abort 82 83 write(u,*) transpose(foo(transpose(e))-1) ! { dg-warning "Creating array temporary" } 84 write(v,*) 2*s+1 85 if (u /= v) call abort 86 87 88 e = transpose(foo(e)) ! { dg-warning "Creating array temporary" } 89 if (any(e /= 2*r+2)) call abort 90 91 write(u,*) transpose(foo(transpose(e)-1)) ! 2 temps { dg-warning "Creating array temporary" } 92 write(v,*) 2*r+2 93 if (u /= v) call abort 94 95 96 a = bar(transpose(c)) 97 if (any(a /= p+4)) call abort 98 99 write(u,*) bar(transpose(c)) 100 write(v,*) p+4 101 if (u /= v) call abort 102 103 104 c = transpose(bar(a)) 105 if (any(c /= q+6)) call abort 106 107 write(u,*) transpose(bar(a)) 108 write(v,*) q+6 109 if (u /= v) call abort 110 111 112 e = bar(transpose(e)) ! { dg-warning "Creating array temporary" } 113 if (any(e /= 2*s+4)) call abort 114 115 write(u,*) transpose(bar(transpose(e)))-2 116 write(v,*) 2*s+4 117 if (u /= v) call abort 118 119 120 e = transpose(bar(e)) ! { dg-warning "Creating array temporary" } 121 if (any(e /= 2*r+6)) call abort 122 123 write(u,*) transpose(transpose(bar(e))-2) 124 write(v,*) 2*r+6 125 if (u /= v) call abort 126 127 128 if (any(a /= transpose(transpose(a)))) call abort ! optimized away 129 130 write(u,*) a 131 write(v,*) transpose(transpose(a)) 132 if (u /= v) call abort 133 134 135 b = a * a 136 137 if (any(transpose(a+b) /= transpose(a)+transpose(b))) call abort ! optimized away 138 139 write(u,*) transpose(a+b) 140 write(v,*) transpose(a) + transpose(b) 141 if (u /= v) call abort 142 143 144 if (any(transpose(matmul(a,c)) /= matmul(transpose(c), transpose(a)))) call abort ! 2 temps { dg-warning "Creating array temporary" } 145 146 write(u,*) transpose(matmul(a,c)) ! { dg-warning "Creating array temporary" } 147 write(v,*) matmul(transpose(c), transpose(a)) ! { dg-warning "Creating array temporary" } 148 if (u /= v) call abort 149 150 151 if (any(transpose(matmul(e,a)) /= matmul(transpose(a), transpose(e)))) call abort ! 2 temps { dg-warning "Creating array temporary" } 152 153 write(u,*) transpose(matmul(e,a)) ! { dg-warning "Creating array temporary" } 154 write(v,*) matmul(transpose(a), transpose(e)) ! { dg-warning "Creating array temporary" } 155 if (u /= v) call abort 156 157 158 call baz (transpose(a)) 159 160 161 call toto1 (a, transpose (c)) 162 if (any (a /= 2 * p + 12)) call abort 163 164 call toto1 (e, transpose (e)) ! { dg-warning "Creating array temporary" } 165 if (any (e /= 4 * s + 12)) call abort 166 167 168 call toto2 (c, transpose (a)) 169 if (any (c /= 2 * q + 13)) call abort 170 171 call toto2 (e, transpose(e)) ! { dg-warning "Creating array temporary" } 172 if (any (e /= 4 * r + 13)) call abort 173 174 call toto2 (e, transpose(transpose(e))) ! { dg-warning "Creating array temporary" } 175 if (any (e /= 4 * r + 14)) call abort 176 177 178 call toto3 (e, transpose(e)) 179 if (any (e /= 4 * r + 14)) call abort 180 181 182 call titi (nx, e, transpose(e)) ! { dg-warning "Creating array temporary" } 183 if (any (e /= 4 * s + 17)) call abort 184 185 contains 186 187 function foo (x) 188 integer, intent(in) :: x(:,:) 189 integer :: foo(size(x,1), size(x,2)) 190 foo = x + 1 191 end function foo 192 193 elemental function bar (x) 194 integer, intent(in) :: x 195 integer :: bar 196 bar = x + 2 197 end function bar 198 199 subroutine baz (x) 200 integer, intent(in) :: x(:,:) 201 end subroutine baz 202 203 elemental subroutine toto1 (x, y) 204 integer, intent(out) :: x 205 integer, intent(in) :: y 206 x = y + y 207 end subroutine toto1 208 209 subroutine toto2 (x, y) 210 integer, dimension(:,:), intent(out) :: x 211 integer, dimension(:,:), intent(in) :: y 212 x = y + 1 213 end subroutine toto2 214 215 subroutine toto3 (x, y) 216 integer, dimension(:,:), intent(in) :: x, y 217 end subroutine toto3 218 219end 220 221subroutine titi (n, x, y) 222 integer :: n, x(n,n), y(n,n) 223 x = y + 3 224end subroutine titi 225 226! No call to transpose 227! { dg-final { scan-tree-dump-times "_gfortran_transpose" 0 "original" } } 228! 229! 24 temporaries 230! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 24 "original" } } 231! 232! 2 tests optimized out 233! { dg-final { scan-tree-dump-times "_gfortran_abort" 39 "original" } } 234! { # Commented out as failing at -O0: dg-final { scan-tree-dump-times "_gfortran_abort" 37 "optimized" } } 235! 236! cleanup 237! { dg-final { cleanup-tree-dump "original" } } 238! { dg-final { cleanup-tree-dump "optimized" } } 239