1! { dg-do compile }
2! Tests the patch for PR28890, in which a reference to a legal reference
3! to an assumed character length function, passed as a dummy, would
4! cause an ICE.
5!
6! Contributed by Paul Thomas  <pault@gcc.gnu.org>
7!
8character(*) function charrext (n)  ! { dg-warning "Obsolescent feature" }
9  character(26) :: alpha ="abcdefghijklmnopqrstuvwxyz"
10  charrext = alpha (1:n)
11end function charrext
12
13  character(26), external :: charrext
14  interface
15    integer(4) function test(charr, i)  ! { dg-warning "Obsolescent feature" }
16     character(*), external :: charr
17     integer :: i
18    end function test
19  end interface
20
21  do j = 1 , 26
22    m = test (charrext, j)
23    m = ctest (charrext, 27 - j)
24  end do
25contains
26  integer(4) function ctest(charr, i)  ! { dg-warning "Obsolescent feature" }
27    character(*) :: charr
28    integer :: i
29    print *, charr(i)
30    ctest = 1
31  end function ctest
32end
33
34integer(4) function test(charr, i)  ! { dg-warning "Obsolescent feature" }
35  character(*) :: charr
36  integer :: i
37  print *, charr(i)
38  test = 1
39end function test
40
41