2 ! { dg-options "-fdump-tree-original -fdump-tree-optimized -Warray-temporaries -fbounds-check" }
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 /))
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 /))
21 integer, dimension(nx,ny) :: a, b
22 integer, dimension(ny,nx) :: c
23 integer, dimension(nx,nx) :: e, f, g
25 character(144) :: u, v
30 if (any(c /= q)) call abort
32 write(u,*) transpose(a)
34 if (u /= v) call abort
41 if (any(g /= r + s)) call abort
43 write(u,*) transpose(e+f)
45 if (u /= v) call abort
48 e = transpose(e) ! { dg-warning "Creating array temporary" }
49 if (any(e /= s)) call abort
51 write(u,*) transpose(transpose(e))
53 if (u /= v) call abort
56 e = transpose(e+f) ! { dg-warning "Creating array temporary" }
57 if (any(e /= 2*r)) call abort
59 write(u,*) transpose(transpose(e+f))-f
61 if (u /= v) call abort
64 a = foo(transpose(c)) ! Unnecessary { dg-warning "Creating array temporary" }
65 if (any(a /= p+1)) call abort
67 write(u,*) foo(transpose(c)) ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
69 if (u /= v) call abort
72 c = transpose(foo(a)) ! Unnecessary { dg-warning "Creating array temporary" }
73 if (any(c /= q+2)) call abort
75 write(u,*) transpose(foo(a)) ! { dg-warning "Creating array temporary" }
77 if (u /= v) call abort
80 e = foo(transpose(e)) ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
81 if (any(e /= 2*s+1)) call abort
83 write(u,*) transpose(foo(transpose(e))-1) ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
85 if (u /= v) call abort
88 e = transpose(foo(e)) ! { dg-warning "Creating array temporary" }
89 if (any(e /= 2*r+2)) call abort
91 write(u,*) transpose(foo(transpose(e)-1)) ! 2 temps { dg-warning "Creating array temporary" }
93 if (u /= v) call abort
97 if (any(a /= p+4)) call abort
99 write(u,*) bar(transpose(c))
101 if (u /= v) call abort
104 c = transpose(bar(a))
105 if (any(c /= q+6)) call abort
107 write(u,*) transpose(bar(a))
109 if (u /= v) call abort
112 e = bar(transpose(e)) ! { dg-warning "Creating array temporary" }
113 if (any(e /= 2*s+4)) call abort
115 write(u,*) transpose(bar(transpose(e)))-2
117 if (u /= v) call abort
120 e = transpose(bar(e)) ! { dg-warning "Creating array temporary" }
121 if (any(e /= 2*r+6)) call abort
123 write(u,*) transpose(transpose(bar(e))-2)
125 if (u /= v) call abort
128 if (any(a /= transpose(transpose(a)))) call abort ! optimized away
131 write(v,*) transpose(transpose(a))
132 if (u /= v) call abort
137 if (any(transpose(a+b) /= transpose(a)+transpose(b))) call abort ! optimized away
139 write(u,*) transpose(a+b)
140 write(v,*) transpose(a) + transpose(b)
141 if (u /= v) call abort
144 if (any(transpose(matmul(a,c)) /= matmul(transpose(c), transpose(a)))) call abort ! 4 temps, should be 2 { dg-warning "Creating array temporary" }
146 write(u,*) transpose(matmul(a,c)) ! { dg-warning "Creating array temporary" }
147 write(v,*) matmul(transpose(c), transpose(a)) ! 3 temps, should be 1 { dg-warning "Creating array temporary" }
148 if (u /= v) call abort
151 if (any(transpose(matmul(e,a)) /= matmul(transpose(a), transpose(e)))) call abort ! 4 temps, should be 2 { dg-warning "Creating array temporary" }
153 write(u,*) transpose(matmul(e,a)) ! { dg-warning "Creating array temporary" }
154 write(v,*) matmul(transpose(a), transpose(e)) ! 3 temps, should be 1 { dg-warning "Creating array temporary" }
155 if (u /= v) call abort
158 call baz (transpose(a)) ! Unnecessary { dg-warning "Creating array temporary" }
160 call toto (f, transpose (e))
161 if (any (f /= 4 * s + 12)) call abort
163 call toto (f, transpose (f)) ! { dg-warning "Creating array temporary" }
164 if (any (f /= 8 * r + 24)) call abort
170 integer, intent(in) :: x(:,:)
171 integer :: foo(size(x,1), size(x,2))
175 elemental function bar (x)
176 integer, intent(in) :: x
182 integer, intent(in) :: x(:,:)
185 elemental subroutine toto (x, y)
186 integer, intent(out) :: x
187 integer, intent(in) :: y
192 ! No call to transpose
193 ! { dg-final { scan-tree-dump-times "_gfortran_transpose" 0 "original" } }
196 ! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 34 "original" } }
198 ! 2 tests optimized out
199 ! { dg-final { scan-tree-dump-times "_gfortran_abort" 34 "original" } }
200 ! { # Commented out as failing at -O0: dg-final { scan-tree-dump-times "_gfortran_abort" 32 "optimized" } }
203 ! { #dg-final { cleanup-tree-dump "original" } }
204 ! { dg-final { cleanup-tree-dump "optimized" } }