1! { dg-do run }
2! Tests the fix for PR19546 in which an ICE would result from
3! setting the parent result in a contained procedure.
4! This case tests character results.
5!
6function f()
7  character(4) :: f
8  f = "efgh"
9  call sub ()
10  if (f.eq."iklm") f = "abcd"
11  call sub ()
12contains
13  subroutine sub
14    f = "wxyz"
15    if (f.eq."efgh") f = "iklm"
16  end subroutine sub
17end function f
18
19function g()              ! { dg-warning "Obsolescent feature" }
20  character(*) :: g
21  g = "efgh"
22  call sub ()
23  if (g.eq."iklm") g = "ABCD"
24  call sub ()
25contains
26  subroutine sub
27    g = "WXYZ"
28    if (g.eq."efgh") g = "iklm"
29  end subroutine sub
30end function g
31
32  character(4), external :: f, g
33  if (f ().ne."wxyz") call abort ()
34  if (g ().ne."WXYZ") call abort ()
35end
36