gcc/testsuite/gfortran.dg/inline_transpose_1.f90

   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)) ! Unnecessary { dg-warning "Creating array temporary" }
  65   if (any(a /= p+1)) call abort
  66
  67   write(u,*) foo(transpose(c))    ! 2 temps, should be 1 { 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))     ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
  81   if (any(e /= 2*s+1)) call abort
  82
  83   write(u,*) transpose(foo(transpose(e))-1)     ! 2 temps, should be 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      ! 4 temps, should be 2 { 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))     ! 3 temps, should be 1 { 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     ! 4 temps, should be 2 { 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))     ! 3 temps, should be 1 { dg-warning "Creating array temporary" }
 155   if (u /= v) call abort
 156
 157
 158   call baz (transpose(a))       ! Unnecessary { dg-warning "Creating array temporary" }
 159
 160   call toto (f, transpose (e))
 161   if (any (f /= 4 * s + 12)) call abort
 162
 163   call toto (f, transpose (f))          ! { dg-warning "Creating array temporary" }
 164   if (any (f /= 8 * r + 24)) call abort
 165
 166
 167   contains
 168
 169   function foo (x)
 170     integer, intent(in) :: x(:,:)
 171     integer :: foo(size(x,1), size(x,2))
 172     foo = x + 1
 173   end function foo
 174
 175   elemental function bar (x)
 176     integer, intent(in) :: x
 177     integer :: bar
 178     bar = x + 2
 179   end function bar
 180
 181   subroutine baz (x)
 182     integer, intent(in) :: x(:,:)
 183   end subroutine baz
 184
 185   elemental subroutine toto (x, y)
 186     integer, intent(out) :: x
 187     integer, intent(in)  :: y
 188     x = y + y
 189   end subroutine toto
 190
 191 end
 192 ! No call to transpose
 193 ! { dg-final { scan-tree-dump-times "_gfortran_transpose" 0 "original" } }
 194 !
 195 ! 34 temporaries
 196 ! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 34 "original" } }
 197 !
 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" } }
 201 !
 202 ! cleanup
 203 ! { #dg-final { cleanup-tree-dump "original" } }
 204 ! { dg-final { cleanup-tree-dump "optimized" } }