gcc/testsuite/gfortran.dg/inline_transpose_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-finline-matmul-limit=0 -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)) STOP 1
  31
  32   write(u,*) transpose(a)
  33   write(v,*) q
  34   if (u /= v) STOP 2
  35
  36
  37   e = r
  38   f = s
  39
  40   g = transpose(e+f)
  41   if (any(g /= r + s)) STOP 3
  42
  43   write(u,*) transpose(e+f)
  44   write(v,*) r + s
  45   if (u /= v) STOP 4
  46
  47
  48   e = transpose(e)      ! { dg-warning "Creating array temporary" }
  49   if (any(e /= s)) STOP 5
  50
  51   write(u,*) transpose(transpose(e))
  52   write(v,*) s
  53   if (u /= v) STOP 6
  54
  55
  56   e = transpose(e+f)     ! { dg-warning "Creating array temporary" }
  57   if (any(e /= 2*r)) STOP 7
  58
  59   write(u,*) transpose(transpose(e+f))-f
  60   write(v,*) 2*r
  61   if (u /= v) STOP 8
  62
  63
  64   a = foo(transpose(c))
  65   if (any(a /= p+1)) STOP 9
  66
  67   write(u,*) foo(transpose(c))    ! { dg-warning "Creating array temporary" }
  68   write(v,*) p+1
  69   if (u /= v) STOP 10
  70
  71
  72   c = transpose(foo(a))      ! Unnecessary { dg-warning "Creating array temporary" }
  73   if (any(c /= q+2)) STOP 11
  74
  75   write(u,*) transpose(foo(a))     ! { dg-warning "Creating array temporary" }
  76   write(v,*) q+2
  77   if (u /= v) STOP 12
  78
  79
  80   e = foo(transpose(e))     ! { dg-warning "Creating array temporary" }
  81   if (any(e /= 2*s+1)) STOP 13
  82
  83   write(u,*) transpose(foo(transpose(e))-1)     ! { dg-warning "Creating array temporary" }
  84   write(v,*) 2*s+1
  85   if (u /= v) STOP 14
  86
  87
  88   e = transpose(foo(e))     ! { dg-warning "Creating array temporary" }
  89   if (any(e /= 2*r+2)) STOP 15
  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) STOP 16
  94
  95
  96   a = bar(transpose(c))
  97   if (any(a /= p+4)) STOP 17
  98
  99   write(u,*) bar(transpose(c))
 100   write(v,*) p+4
 101   if (u /= v) STOP 18
 102
 103
 104   c = transpose(bar(a))
 105   if (any(c /= q+6)) STOP 19
 106
 107   write(u,*) transpose(bar(a))
 108   write(v,*) q+6
 109   if (u /= v) STOP 20
 110
 111
 112   e = bar(transpose(e))     ! { dg-warning "Creating array temporary" }
 113   if (any(e /= 2*s+4)) STOP 21
 114
 115   write(u,*) transpose(bar(transpose(e)))-2
 116   write(v,*) 2*s+4
 117   if (u /= v) STOP 22
 118
 119
 120   e = transpose(bar(e))     ! { dg-warning "Creating array temporary" }
 121   if (any(e /= 2*r+6)) STOP 23
 122
 123   write(u,*) transpose(transpose(bar(e))-2)
 124   write(v,*) 2*r+6
 125   if (u /= v) STOP 24
 126
 127
 128   if (any(a /= transpose(transpose(a)))) STOP 25! optimized away
 129
 130   write(u,*) a
 131   write(v,*) transpose(transpose(a))
 132   if (u /= v) STOP 26
 133
 134
 135   b = a * a
 136
 137   if (any(transpose(a+b) /= transpose(a)+transpose(b))) STOP 27! optimized away
 138
 139   write(u,*) transpose(a+b)
 140   write(v,*) transpose(a) + transpose(b)
 141   if (u /= v) STOP 28
 142
 143
 144   if (any(transpose(matmul(a,c)) /= matmul(transpose(c), transpose(a)))) STOP 29! 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) STOP 30
 149
 150
 151   if (any(transpose(matmul(e,a)) /= matmul(transpose(a), transpose(e)))) STOP 31! 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) STOP 32
 156
 157
 158   call baz (transpose(a))
 159
 160
 161   call toto1 (a, transpose (c))
 162   if (any (a /= 2 * p + 12)) STOP 33
 163
 164   call toto1 (e, transpose (e))          ! { dg-warning "Creating array temporary" }
 165   if (any (e /= 4 * s + 12)) STOP 34
 166
 167
 168   call toto2 (c, transpose (a))
 169   if (any (c /= 2 * q + 13)) STOP 35
 170
 171   call toto2 (e, transpose(e))           ! { dg-warning "Creating array temporary" }
 172   if (any (e /= 4 * r + 13)) STOP 36
 173
 174   call toto2 (e, transpose(transpose(e)))           ! { dg-warning "Creating array temporary" }
 175   if (any (e /= 4 * r + 14)) STOP 37
 176
 177
 178   call toto3 (e, transpose(e))
 179   if (any (e /= 4 * r + 14)) STOP 38
 180
 181
 182   call titi (nx, e, transpose(e))           ! { dg-warning "Creating array temporary" }
 183   if (any (e /= 4 * s + 17)) STOP 39
 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
 219 end
 220
 221 subroutine titi (n, x, y)
 222   integer :: n, x(n,n), y(n,n)
 223   x = y + 3
 224 end 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_stop" 39 "original" } }
 234 ! { # Commented out as failing at -O0: dg-final { scan-tree-dump-times "_gfortran_stop" 37 "optimized" } }
 235 !
 236 ! cleanup