1! { dg-do run }
2! { dg-options "-std=legacy" }
3!
4! Test assignments from character pointer functions with dependencies
5! are correctly resolved.
6! Provided by Paul Thomas pault@gcc.gnu.org
7program char_pointer_dependency
8  implicit none
9  character*4, pointer       :: c2(:)
10  allocate (c2(2))
11  c2 = (/"abcd","efgh"/)
12  c2 = afoo (c2)
13  if (c2(1) /= "efgh") call abort ()
14  if (c2(2) /= "abcd") call abort ()
15  deallocate (c2)
16contains
17  function afoo (ac0) result (ac1)
18    integer                    :: j
19    character*4                :: ac0(:)
20    character*4, pointer       :: ac1(:)
21    allocate (ac1(2))
22    do j = 1,2
23      ac1(j) = ac0(3-j)
24    end do
25  end function afoo
26end program char_pointer_dependency
27