1! { dg-do compile }
2! { dg-options "-fdump-tree-original -fcoarray=lib" }
3!
4! PR fortran/52052
5!
6! Test that for CAF components _gfortran_caf_deregister is called
7! Test that norealloc happens for CAF components during assignment
8!
9module m
10type t
11  integer, allocatable :: CAF[:]
12  integer, allocatable :: ii
13end type t
14end module m
15
16subroutine foo()
17use m
18type(t) :: x,y
19if (allocated(x%caf)) call abort()
20x = y
21end
22
23! For comp%ii: End of scope of x + y (2x) and for the LHS of the assignment (1x)
24! { dg-final { scan-tree-dump-times "__builtin_free" 3 "original" } }
25
26! For comp%CAF:  End of scope of x + y (2x); no LHS freeing for the CAF in assignment
27! { dg-final { scan-tree-dump-times "_gfortran_caf_deregister" 2 "original" } }
28
29! Only malloc "ii":
30! { dg-final { scan-tree-dump-times "__builtin_malloc" 1 "original" } }
31
32! But copy "ii" and "CAF":
33! { dg-final { scan-tree-dump-times "__builtin_memcpy|= MEM" 2 "original" } }
34
35! { dg-final { cleanup-tree-dump "original" } }
36