|
111
|
1 ! { dg-do run }
|
|
|
2 ! { dg-options "-std=legacy" }
|
|
|
3 !
|
|
|
4 program 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)
|
|
|
22 contains
|
|
|
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
|
|
|
35 end program char_pointer_dummy
|
|
|
36
|
