Patchwork [fortran,1/11] Inline transpose part 1

login
register
mail settings
Submitter Mikael Morin
Date Sept. 4, 2010, 2:18 p.m.
Message ID <4C825518.90302@sfr.fr>
Download mbox | patch
Permalink /patch/63778/
State New
Headers show

Comments

Mikael Morin - Sept. 4, 2010, 2:18 p.m.
This is the testcase (to be updated with the 10/11 patch).
We change the name of the descriptor created by transpose so that it is 
not matched in the tree dump as a temporary.
OK for trunk?
2010-09-03  Mikael Morin  <mikael@gcc.gnu.org>

	* trans-array.c (gfc_conv_array_transpose): Change generated descriptor
	name
Mikael Morin - Sept. 4, 2010, 2:20 p.m.
Le 04.09.2010 16:18, Mikael Morin a écrit :
> This is the testcase (to be updated with the 10/11 patch).
> We change the name of the descriptor created by transpose so that it is
> not matched in the tree dump as a temporary.
> OK for trunk?
>
Grr! Forgot the testcase.
! { dg-do run }
! { dg-options "-fdump-tree-original -Warray-temporaries" }

  implicit none

  integer :: i, j

  integer, parameter :: nx=3, ny=4
  integer, parameter, dimension(nx,ny) :: p = &
    & reshape ((/ (i**2, i=1,size(p)) /), shape(p))
  integer, parameter, dimension(ny,nx) :: q = &
    & reshape ((/ (((nx*(i-1)+j)**2, i=1,ny), j=1,nx) /), (/ ny, nx /))

  integer, parameter, dimension(nx,nx) :: r = &
    & reshape ((/ (i*i, i=1,size(r)) /), shape(r))
  integer, parameter, dimension(nx,nx) :: s = &
    & reshape ((/ (((nx*(i-1)+j)**2, i=1,nx), j=1,nx) /), (/ nx, nx /))
 
  
  
  integer, dimension(nx,ny) :: a, b
  integer, dimension(ny,nx) :: c
  integer, dimension(nx,nx) :: e, f, g

  character(144) :: u, v
  
  a = p
  
  c = transpose(a)
  if (any(c /= q)) call abort

  write(u,*) transpose(a)       ! Unnecessary { dg-warning "Creating array temporary" }
  write(v,*) q
  if (u /= v) call abort


  e = r
  f = s

  g = transpose(e+f)            ! Unnecessary { dg-warning "Creating array temporary" }
  if (any(g /= r + s)) call abort

  write(u,*) transpose(e+f)     ! 2 Unnecessary temps { dg-warning "Creating array temporary" }
  write(v,*) r + s
  if (u /= v) call abort


  e = transpose(e)      ! { dg-warning "Creating array temporary" }
  if (any(e /= s)) call abort

  write(u,*) transpose(transpose(e))    ! Unnecessary { dg-warning "Creating array temporary" }
  write(v,*) s
  if (u /= v) call abort
  

  e = transpose(e+f)     ! { dg-warning "Creating array temporary" }
  if (any(e /= 2*r)) call abort

  write(u,*) transpose(transpose(e+f))-f        ! 2 Unnecessary temps { dg-warning "Creating array temporary" }
  write(v,*) 2*r
  if (u /= v) call abort
  

  a = foo(transpose(c))
  if (any(a /= p+1)) call abort

  write(u,*) foo(transpose(c))    ! { dg-warning "Creating array temporary" }
  write(v,*) p+1
  if (u /= v) call abort
  

  c = transpose(foo(a))      ! Unnecessary { dg-warning "Creating array temporary" }     
  if (any(c /= q+2)) call abort

  write(u,*) transpose(foo(a))     ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
  write(v,*) q+2
  if (u /= v) call abort


  e = foo(transpose(e))     ! { dg-warning "Creating array temporary" }
  if (any(e /= 2*s+1)) call abort

  write(u,*) transpose(foo(transpose(e))-1)     ! 3 temps, should be 1 { dg-warning "Creating array temporary" }
  write(v,*) 2*s+1
  if (u /= v) call abort


  e = transpose(foo(e))     ! { dg-warning "Creating array temporary" }
  if (any(e /= 2*r+2)) call abort

  write(u,*) transpose(foo(transpose(e)-1))     ! 4 temps, should be 2 { dg-warning "Creating array temporary" }
  write(v,*) 2*r+2
  if (u /= v) call abort
  

  a = bar(transpose(c))         ! Unnecessary { dg-warning "Creating array temporary" }
  if (any(a /= p+4)) call abort
  
  write(u,*) bar(transpose(c))  ! Unnecessary { dg-warning "Creating array temporary" }
  write(v,*) p+4
  if (u /= v) call abort
  

  c = transpose(bar(a))         ! Unnecessary { dg-warning "Creating array temporary" }
  if (any(c /= q+6)) call abort

  write(u,*) transpose(bar(a))  ! 2 Unnecessary temps { dg-warning "Creating array temporary" }
  write(v,*) q+6
  if (u /= v) call abort


  e = bar(transpose(e))     ! { dg-warning "Creating array temporary" }
  if (any(e /= 2*s+4)) call abort

  write(u,*) transpose(bar(transpose(e)))-2     ! 3 Unnecessary temps { dg-warning "Creating array temporary" }
  write(v,*) 2*s+4
  if (u /= v) call abort


  e = transpose(bar(e))     ! { dg-warning "Creating array temporary" }
  if (any(e /= 2*r+6)) call abort

  write(u,*) transpose(transpose(bar(e))-2)     ! 4 Unnecessary temps { dg-warning "Creating array temporary" }
  write(v,*) 2*r+6
  if (u /= v) call abort


  if (any(a /= transpose(transpose(a)))) call abort     ! Unnecessary { dg-warning "Creating array temporary" }

  write(u,*) a
  write(v,*) transpose(transpose(a))    ! Unnecessary { dg-warning "Creating array temporary" }
  if (u /= v) call abort


  b = a * a

  if (any(transpose(a+b) /= transpose(a)+transpose(b))) call abort      ! 4 unnecessary temps { dg-warning "Creating array temporary" }

  write(u,*) transpose(a+b)     ! 2 unnecessary temps { dg-warning "Creating array temporary" }
  write(v,*) transpose(a) + transpose(b)        ! 2 unnecessary temps { dg-warning "Creating array temporary" }
  if (u /= v) call abort


  if (any(transpose(matmul(a,c)) /= matmul(transpose(c), transpose(a)))) call abort      ! 3 temps, should be 2 { dg-warning "Creating array temporary" }

  write(u,*) transpose(matmul(a,c))     ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
  write(v,*) matmul(transpose(c), transpose(a))     ! { dg-warning "Creating array temporary" }
  if (u /= v) call abort


  if (any(transpose(matmul(e,a)) /= matmul(transpose(a), transpose(e)))) call abort     ! 3 temps, should be 2 { dg-warning "Creating array temporary" }

  write(u,*) transpose(matmul(e,a))     ! 2 temps, should be 1 { dg-warning "Creating array temporary" }
  write(v,*) matmul(transpose(a), transpose(e))     ! { dg-warning "Creating array temporary" }
  if (u /= v) call abort


  call baz (transpose(a))

  call toto (f, transpose (e))          ! Unnecessary { dg-warning "Creating array temporary" }
  if (any (f /= 4 * s + 12)) call abort

  call toto (f, transpose (f))          ! { dg-warning "Creating array temporary" }
  if (any (f /= 8 * r + 24)) call abort
  
  
  contains
  
  function foo (x)
    integer, intent(in) :: x(:,:)
    integer :: foo(size(x,1), size(x,2))
    foo = x + 1
  end function foo
  
  elemental function bar (x)
    integer, intent(in) :: x
    integer :: bar
    bar = x + 2
  end function bar

  subroutine baz (x)
    integer, intent(in) :: x(:,:)
  end subroutine baz

  elemental subroutine toto (x, y)
    integer, intent(out) :: x
    integer, intent(in)  :: y
    x = y + y
  end subroutine toto
  
end
! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 60 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

Patch

diff --git a/trans-array.c b/trans-array.c
index e355901..7cd890e 100644
--- a/trans-array.c
+++ b/trans-array.c
@@ -894,7 +894,7 @@  gfc_conv_array_transpose (gfc_se * se, gfc_expr * expr)
   src = src_se.expr;
 
   /* Allocate a new descriptor for the return value.  */
-  dest = gfc_create_var (TREE_TYPE (src), "atmp");
+  dest = gfc_create_var (TREE_TYPE (src), "transp");
   dest_info->descriptor = dest;
   se->expr = dest;