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