diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90 | |
download | cbb-gcc-4.6.4-upstream.tar.bz2 cbb-gcc-4.6.4-upstream.tar.xz |
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.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90 | 57 |
1 files changed, 57 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90 new file mode 100644 index 000000000..9d87af2f8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90 @@ -0,0 +1,57 @@ +! { dg-do run } +! Test assignments of derived type with allocatable components (PR 20541). +! +! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org> +! and Paul Thomas <pault@gcc.gnu.org> +! + type :: ivs + character(1), allocatable :: chars(:) + end type ivs + + type(ivs) :: a, b + type(ivs) :: x(3), y(3) + + allocate(a%chars(5)) + a%chars = (/"h","e","l","l","o"/) + +! An intrinsic assignment must deallocate the l-value and copy across +! the array from the r-value. + b = a + if (any (b%chars .ne. (/"h","e","l","l","o"/))) call abort () + if (allocated (a%chars) .eqv. .false.) call abort () + +! Scalar to array needs to copy the derived type, to its ultimate components, +! to each of the l-value elements. */ + x = b + x(2)%chars = (/"g","'","d","a","y"/) + if (any (x(1)%chars .ne. (/"h","e","l","l","o"/))) call abort () + if (any (x(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () + if (allocated (b%chars) .eqv. .false.) call abort () + deallocate (x(1)%chars, x(2)%chars, x(3)%chars) + +! Array intrinsic assignments are like their scalar counterpart and +! must deallocate each element of the l-value and copy across the +! arrays from the r-value elements. + allocate(x(1)%chars(5), x(2)%chars(5), x(3)%chars(5)) + x(1)%chars = (/"h","e","l","l","o"/) + x(2)%chars = (/"g","'","d","a","y"/) + x(3)%chars = (/"g","o","d","a","g"/) + y(2:1:-1) = x(1:2) + if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () + if (any (y(2)%chars .ne. (/"h","e","l","l","o"/))) call abort () + if (any (x(3)%chars .ne. (/"g","o","d","a","g"/))) call abort () + +! In the case of an assignment where there is a dependency, so that a +! temporary is necessary, each element must be copied to its +! destination after it has been deallocated. + y(2:3) = y(1:2) + if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () + if (any (y(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () + if (any (y(3)%chars .ne. (/"h","e","l","l","o"/))) call abort () + +! An identity assignment must not do any deallocation....! + y = y + if (any (y(1)%chars .ne. (/"g","'","d","a","y"/))) call abort () + if (any (y(2)%chars .ne. (/"g","'","d","a","y"/))) call abort () + if (any (y(3)%chars .ne. (/"h","e","l","l","o"/))) call abort () +end |