1! { dg-do run }
2! { dg-options "-std=legacy" }
3!
4program char_pointer_dummy
5! Test character pointer dummy arguments, required
6! to fix PR16939 and PR18689
7! Provided by Paul Thomas pault@gcc.gnu.org
8  implicit none
9  character*4                :: c0
10  character*4, pointer       :: c1
11  character*4, pointer       :: c2(:)
12  allocate (c1, c2(1))
13! Check that we have not broken non-pointer characters.
14  c0 = "wxyz"
15  call foo (c0)
16! Now the pointers
17  c1 = "wxyz"
18  call sfoo (c1)
19  c2 = "wxyz"
20  call afoo (c2)
21  deallocate (c1, c2)
22contains
23  subroutine foo (cc1)
24    character*4                :: cc1
25    if (cc1 /= "wxyz") call abort ()
26  end subroutine foo
27  subroutine sfoo (sc1)
28    character*4, pointer       :: sc1
29    if (sc1 /= "wxyz") call abort ()
30  end subroutine sfoo
31  subroutine afoo (ac1)
32    character*4, pointer       :: ac1(:)
33    if (ac1(1) /= "wxyz") call abort ()
34  end subroutine afoo
35end program char_pointer_dummy
36
37