summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/alloc_comp_assign_1.f90
blob: 9d87af2f84729d1ed5aec1d1219ff9236a288afd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
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