1! { dg-do run }
2! { dg-options "-fcoarray=lib -lcaf_single -fdump-tree-original" }
3! { dg-additional-options "-latomic" { target libatomic_available } }
4!
5! Allocate/deallocate with libcaf.
6!
7
8program test_caf_alloc
9
10  type t
11    integer, allocatable :: i
12    real, allocatable :: r(:)
13  end type t
14
15  type(t), allocatable :: xx[:]
16
17  allocate (xx[*])
18
19  if (allocated(xx%i)) STOP 1
20  if (allocated(xx[1]%i)) STOP 2
21  if (allocated(xx[1]%r)) STOP 3
22  allocate(xx%i)
23  if (.not. allocated(xx[1]%i)) STOP 4
24  if (allocated(xx[1]%r)) STOP 5
25
26  allocate(xx%r(5))
27  if (.not. allocated(xx[1]%i)) STOP 6
28  if (.not. allocated(xx[1]%r)) STOP 7
29
30  deallocate(xx%i)
31  if (allocated(xx[1]%i)) STOP 8
32  if (.not. allocated(xx[1]%r)) STOP 9
33
34  deallocate(xx%r)
35  if (allocated(xx[1]%i)) STOP 10
36  if (allocated(xx[1]%r)) STOP 11
37
38  deallocate(xx)
39end
40
41! { dg-final { scan-tree-dump-times "_gfortran_caf_is_present \\(xx\\.token, \\(integer\\(kind=4\\)\\) \\(2 - xx\\.dim\\\[0\\\]\\.lbound\\), &caf_ref\\.\[0-9\]+\\)|_gfortran_caf_is_present \\(xx\\.token, 2 - xx\\.dim\\\[0\\\]\\.lbound, &caf_ref\\.\[0-9\]+\\)" 10 "original" } }
42! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(\[0-9\]+, 1, &xx\\.token, \\(void \\*\\) &xx, 0B, 0B, 0\\)" 1 "original" } }
43! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(\[0-9\]+, 7" 2 "original" } }
44! { dg-final { scan-tree-dump-times "_gfortran_caf_register \\(\[0-9\]+, 8" 2 "original" } }
45! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister \\(&xx\\.token, 0, 0B, 0B, 0\\)" 1 "original" } }
46! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister \\(&\\(\\(struct t \\* restrict\\) xx\\.data\\)->r\\.token, 1, 0B, 0B, 0\\)" 1 "original" } }
47! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister \\(&\\(\\(struct t \\* restrict\\) xx\\.data\\)->_caf_i, 1, 0B, 0B, 0\\)" 1 "original" } }
48