1! { dg-do run }
2! This tests the fix for pr15809 in which automatic character length,
3! dummy, pointer arrays were broken.
4!
5! contributed by Paul Thomas  <pault@gcc.gnu.org>
6!
7module global
8  character(12), dimension(2), target :: t
9end module global
10
11program oh_no_not_pr15908_again
12  character(12), dimension(:), pointer :: ptr
13
14  nullify(ptr)
15
16  call a (ptr, 12)
17  if (.not.associated (ptr) ) call abort ()
18  if (any (ptr.ne."abc")) call abort ()
19
20  ptr => null ()              ! ptr points to 't' here.
21  allocate (ptr(3))
22  ptr = "xyz"
23  call a (ptr, 12)
24
25  if (.not.associated (ptr)) call abort ()
26  if (any (ptr.ne."lmn")) call abort ()
27
28  call a (ptr, 0)
29
30  if (associated (ptr)) call abort ()
31
32contains
33
34  subroutine a (p, l)
35    use global
36    character(l), dimension(:), pointer :: p
37    character(l), dimension(3)          :: s
38
39    s = "lmn"
40
41    if (l.ne.12) then
42      deallocate (p)           ! ptr was allocated in main.
43      p => null ()
44      return
45    end if
46
47    if (.not.associated (p)) then
48      t = "abc"
49      p => t
50    else
51      if (size (p,1).ne.3) call abort ()
52      if (any (p.ne."xyz")) call abort ()
53      p = s
54    end if
55  end subroutine a
56
57end program oh_no_not_pr15908_again
58