obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

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.

1 files changed, 153 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_2.f03 b/gcc/testsuite/gfortran.dg/realloc_on_assign_2.f03
new file mode 100644
index 000000000..0564d0d50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_2.f03
@@ -0,0 +1,153 @@
+! { dg-do run }
+! { dg-skip-if "Too big for local store" { spu-*-* } { "*" } { "" } }
+! Tests the patch that implements F2003 automatic allocation and
+! reallocation of allocatable arrays on assignment.  The tests
+! below were generated in the final stages of the development of
+! this patch.
+! test1 has been corrected for PR47051
+!
+! Contributed by Dominique Dhumieres <dominiq@lps.ens.fr>
+!            and Tobias Burnus <burnus@gcc.gnu.org>
+!
+  integer :: nglobal
+  call test1
+  call test2
+  call test3
+  call test4
+  call test5
+  call test6
+  call test7
+  call test8
+contains
+  subroutine test1
+!
+! Check that the bounds are set correctly, when assigning
+! to an array that already has the correct shape.
+!
+    real :: a(10) = 1, b(51:60) = 2
+    real, allocatable :: c(:), d(:)
+    c=a
+    if (lbound (c, 1) .ne. lbound(a, 1)) call abort
+    if (ubound (c, 1) .ne. ubound(a, 1)) call abort
+    c=b
+! 7.4.1.3 "If variable is an allocated allocatable variable, it is
+! deallocated if expr is an array of different shape or any of the
+! corresponding length type parameter values of variable and expr
+! differ." Here the shape is the same so the deallocation does not
+! occur and the bounds are not recalculated. This was corrected
+! for the fix of PR47051. 
+    if (lbound (c, 1) .ne. lbound(a, 1)) call abort
+    if (ubound (c, 1) .ne. ubound(a, 1)) call abort
+    d=b
+    if (lbound (d, 1) .ne. lbound(b, 1)) call abort
+    if (ubound (d, 1) .ne. ubound(b, 1)) call abort
+    d=a
+! The other PR47051 correction.
+    if (lbound (d, 1) .ne. lbound(b, 1)) call abort
+    if (ubound (d, 1) .ne. ubound(b, 1)) call abort
+  end subroutine
+  subroutine test2
+!
+! Check that the bounds are set correctly, when making an
+! assignment with an implicit conversion.  First with a
+! non-descriptor variable....
+!
+    integer(4), allocatable :: a(:)
+    integer(8) :: b(5:6)
+    a = b
+    if (lbound (a, 1) .ne. lbound(b, 1)) call abort
+    if (ubound (a, 1) .ne. ubound(b, 1)) call abort
+  end subroutine
+  subroutine test3
+!
+! ...and now a descriptor variable.
+!
+    integer(4), allocatable :: a(:)
+    integer(8), allocatable :: b(:)
+    allocate (b(7:11))
+    a = b
+    if (lbound (a, 1) .ne. lbound(b, 1)) call abort
+    if (ubound (a, 1) .ne. ubound(b, 1)) call abort
+  end subroutine
+  subroutine test4
+!
+! Check assignments of the kind a = f(...)
+!
+    integer, allocatable :: a(:)
+    integer, allocatable :: c(:)
+    a = f()
+    if (any (a .ne. [1, 2, 3, 4])) call abort
+    c = a + 8
+    a = f (c)
+    if (any ((a - 8) .ne. [1, 2, 3, 4])) call abort
+    deallocate (c)
+    a = f (c)
+    if (any ((a - 4) .ne. [1, 2, 3, 4])) call abort
+  end subroutine
+  function f(b)
+    integer, allocatable, optional :: b(:)
+    integer :: f(4)
+    if (.not.present (b)) then
+      f = [1,2,3,4]
+    elseif (.not.allocated (b)) then
+      f = [5,6,7,8]
+    else
+      f = b
+    end if
+  end function f
+  
+  subroutine test5
+!
+! Extracted from rnflow.f90, Polyhedron benchmark suite,
+! http://www.polyhedron.com
+!
+    integer, parameter :: ncls = 233, ival = 16, ipic = 17
+    real, allocatable, dimension (:,:) :: utrsft
+    real, allocatable, dimension (:,:) :: dtrsft
+    real, allocatable, dimension (:,:) :: xwrkt
+    allocate (utrsft(ncls, ncls), dtrsft(ncls, ncls))
+    nglobal = 0
+    xwrkt = trs2a2 (ival, ipic, ncls)
+    if (any (shape (xwrkt) .ne. [ncls, ncls])) call abort
+    xwrkt = invima (xwrkt, ival, ipic, ncls)
+    if (nglobal .ne. 1) call abort
+    if (sum(xwrkt) .ne. xwrkt(ival, ival)) call abort
+  end subroutine
+  function trs2a2 (j, k, m)
+    real, dimension (1:m,1:m) :: trs2a2
+    integer, intent (in)      :: j, k, m
+    nglobal = nglobal + 1
+    trs2a2 = 0.0
+  end function trs2a2
+  function invima (a, j, k, m)
+    real, dimension (1:m,1:m)              :: invima
+    real, dimension (1:m,1:m), intent (in) :: a
+    integer, intent (in)            :: j, k
+    invima = 0.0
+    invima (j, j) = 1.0 / (1.0 - a (j, j))
+  end function invima
+  subroutine test6
+    character(kind=1, len=100), allocatable, dimension(:) :: str
+    str = [ "abc" ]
+    if (TRIM(str(1)) .ne. "abc") call abort
+    if (len(str) .ne. 100) call abort
+  end subroutine
+  subroutine test7
+    character(kind=4, len=100), allocatable, dimension(:) :: str
+    character(kind=4, len=3) :: test = "abc"
+    str = [ "abc" ]
+    if (TRIM(str(1)) .ne. test) call abort
+    if (len(str) .ne. 100) call abort
+  end subroutine
+  subroutine test8
+    type t
+      integer, allocatable :: a(:)
+    end type t
+    type(t) :: x
+    x%a= [1,2,3]
+    if (any (x%a .ne. [1,2,3])) call abort
+    x%a = [4]
+    if (any (x%a .ne. [4])) call abort
+  end subroutine
+end
+