1! { dg-do run }
2! { dg-options "-fcoarray=lib -lcaf_single" }
3! { dg-additional-options "-latomic" { target libatomic_available } }
4!
5! Contributed by Andre Vehreschild
6! Check that manually freeing components does not lead to a runtime crash,
7! when the auto-deallocation is taking care.
8
9program coarray_alloc_comp_3
10  implicit none
11
12  type dt
13    integer, allocatable :: i
14  end type dt
15
16  type linktype
17    type(dt), allocatable :: link
18  end type linktype
19
20  type(linktype), allocatable :: obj[:]
21
22  allocate(obj[*])
23  allocate(obj%link)
24
25  if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated."
26  if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated."
27  if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' already allocated."
28
29  allocate(obj%link%i, source = 42)
30
31  if (.not. allocated(obj)) error stop "Test failed. 'obj' not allocated."
32  if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated."
33  if (.not. allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' not allocated."
34  if (obj%link%i /= 42) error stop "Test failed. obj%link%i /= 42."
35
36  deallocate(obj%link%i)
37
38  if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' still allocated."
39  if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' no longer allocated."
40  if (.not. allocated(obj)) error stop "Test failed. 'obj' no longer allocated."
41
42  ! Freeing this object, lead to crash with older gfortran...
43  deallocate(obj%link)
44
45  if (allocated(obj%link)) error stop "Test failed. 'obj%link' still allocated."
46  if (.not. allocated(obj)) error stop "Test failed. 'obj' no longer allocated."
47
48  ! ... when auto-deallocating the allocated components.
49  deallocate(obj)
50
51  if (allocated(obj)) error stop "Test failed. 'obj' still allocated."
52end program
53