| ! { dg-do compile } |
| ! { dg-options "-fcoarray=lib -fdump-tree-original" } |
| ! { dg-additional-options "-latomic" { target libatomic_available } } |
| ! |
| ! Contributed by Andre Vehreschild |
| ! Check that sub-components are caf_deregistered and not freed. |
| |
| program coarray_alloc_comp_3 |
| implicit none |
| |
| type dt |
| integer, allocatable :: i |
| end type dt |
| |
| type linktype |
| type(dt), allocatable :: link |
| end type linktype |
| |
| type(linktype) :: obj[*] |
| |
| allocate(obj%link) |
| |
| if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated." |
| if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' already allocated." |
| |
| allocate(obj%link%i, source = 42) |
| |
| if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' not allocated." |
| if (.not. allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' not allocated." |
| if (obj%link%i /= 42) error stop "Test failed. obj%link%i /= 42." |
| |
| deallocate(obj%link%i) |
| |
| if (allocated(obj%link%i)) error stop "Test failed. 'obj%link%i' still allocated." |
| if (.not. allocated(obj%link)) error stop "Test failed. 'obj%link' no longer allocated." |
| |
| ! Freeing this object, lead to crash with older gfortran... |
| deallocate(obj%link) |
| |
| if (allocated(obj%link)) error stop "Test failed. 'obj%link' still allocated." |
| end program |
| ! Ensure, that three calls to deregister are present. |
| ! { dg-final { scan-tree-dump-times "_caf_deregister" 3 "original" } } |
| ! And ensure that no calls to builtin_free are made. |
| ! { dg-final { scan-tree-dump-not "_builtin_free" "original" } } |