From 68eabe8cd741658822954a5dd2bb7679425e64f8 Mon Sep 17 00:00:00 2001 From: mikael Date: Thu, 9 Sep 2010 12:56:12 +0000 Subject: [PATCH] 2010-09-09 Mikael Morin * trans-array.c (gfc_conv_array_transpose): Change generated descriptor name 2010-09-09 Mikael Morin * gfortran.dg/inline_transpose_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@164087 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 5 + gcc/fortran/trans-array.c | 2 +- gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gfortran.dg/inline_transpose_1.f90 | 193 +++++++++++++++++++++++ 4 files changed, 203 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/inline_transpose_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8e17f05..3ecf53d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2010-09-09 Mikael Morin + + * trans-array.c (gfc_conv_array_transpose): Change generated descriptor + name + 2010-09-09 Tobias Burnus PR fortran/43665 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0cb5b1e..154ecc4 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -906,7 +906,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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1ad764c..d2a2393 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2010-09-09 Mikael Morin + + * gfortran.dg/inline_transpose_1.f90: New test. + 2010-09-08 Jakub Jelinek PR c++/45588 diff --git a/gcc/testsuite/gfortran.dg/inline_transpose_1.f90 b/gcc/testsuite/gfortran.dg/inline_transpose_1.f90 new file mode 100644 index 0000000..4b79138 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inline_transpose_1.f90 @@ -0,0 +1,193 @@ +! { 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" } } -- 2.7.4