1! { dg-do compile }
2! { dg-options "-fcoarray=lib -fdump-tree-original" }
3! { dg-additional-options "-latomic" { target libatomic_available } }
4!
5! Contributed by Andre Vehreschild
6! Check that sub-components are caf_deregistered and not freed.
7
8program coarray_alloc_comp_3
9  implicit none
10
11  type dt
12    integer, allocatable :: i
13  end type dt
14
15  type linktype
16    type(dt), allocatable :: link
17  end type linktype
18
19  type(linktype) :: obj[*]
20
21  allocate(obj%link)
22
23  if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated."
24  if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' already allocated."
25
26  allocate(obj%link%i, source = 42)
27
28  if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated."
29  if (.not. allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' not allocated."
30  if (obj%link%i /= 42) error stop "Test failed. obj%link%i /= 42."
31
32  deallocate(obj%link%i)
33
34  if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' still allocated."
35  if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' no longer allocated."
36
37  ! Freeing this object, lead to crash with older gfortran...
38  deallocate(obj%link)
39
40  if (allocated(obj%link)) error stop "Test failed. 'obj%link' still allocated."
41end program
42! Ensure, that three calls to deregister are present.
43! { dg-final { scan-tree-dump-times "_caf_deregister" 3 "original" } }
44! And ensure that no calls to builtin_free are made.
45! { dg-final { scan-tree-dump-not "_builtin_free" "original" } }
46