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