From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- .../gfortran.dg/elemental_subroutine_3.f90 | 53 ++++++++++++++++++++++ 1 file changed, 53 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/elemental_subroutine_3.f90 (limited to 'gcc/testsuite/gfortran.dg/elemental_subroutine_3.f90') diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_3.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_3.f90 new file mode 100644 index 000000000..1f93cd4a2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_3.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! Test the fix for PR25746, in which dependency checking was not being +! done for elemental subroutines and therefore for interface assignments. +! +! This test is based on +! http://home.comcast.net/~kmbtib/Fortran_stuff/elem_assign.f90 +! as reported by Harald Anlauf in the PR. +! +module elem_assign + implicit none + type mytype + integer x + end type mytype + interface assignment(=) + module procedure myassign + end interface assignment(=) + contains + elemental subroutine myassign(x,y) + type(mytype), intent(out) :: x + type(mytype), intent(in) :: y +! Multiply the components by 2 to verify that this is being called. + x%x = y%x*2 + end subroutine myassign +end module elem_assign + +program test + use elem_assign + implicit none + type(mytype) :: y(6), x(6) = (/mytype(1),mytype(20),mytype(300),& + mytype(4000),mytype(50000),& + mytype(1000000)/) + type(mytype) :: z(2, 3) +! The original case - dependency between lhs and rhs. + x = x((/2,3,1,4,5,6/)) + if (any(x%x .ne. (/40, 600, 2, 8000, 100000, 2000000/))) call abort () +! Slightly more elborate case with non-trivial array ref on lhs. + x(4:1:-1) = x((/1,3,2,4/)) + if (any(x%x .ne. (/16000, 1200, 4, 80, 100000, 2000000/))) call abort () +! Check that no-dependence case works.... + y = x + if (any(y%x .ne. (/32000, 2400, 8, 160, 200000, 4000000/))) call abort () +! ...and now a case that caused headaches during the preparation of the patch + x(2:5) = x(1:4) + if (any(x%x .ne. (/16000, 32000, 2400, 8, 160, 2000000/))) call abort () +! Check offsets are done correctly in multi-dimensional cases + z = reshape (x, (/2,3/)) + z(:, 3:2:-1) = z(:, 1:2) + y = reshape (z, (/6/)) + if (any(y%x .ne. (/ 64000, 128000, 19200, 64, 128000, 256000/))) call abort () +end program test + +! { dg-final { cleanup-modules "elem_assign" } } + -- cgit v1.2.3