1! { dg-do run }
2! Tests the check for PR31215, in which actual/formal interface
3! was not being correctly handled for the size of 'r' because
4! it is a result.
5!
6! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
7!
8module test1
9  implicit none
10contains
11  character(f(x)) function test2(x) result(r)
12    implicit integer (x)
13    dimension r(len(r)+1)
14    integer, intent(in) :: x
15    interface
16      pure function f(x)
17        integer, intent(in) :: x
18        integer f
19      end function f
20    end interface
21    integer i
22    do i = 1, len(r)
23      r(:)(i:i) = achar(mod(i,32)+iachar('@'))
24    end do
25  end function test2
26end module test1
27
28program test
29  use test1
30  implicit none
31! Original problem
32  if (len(test2(10)) .ne. 21) STOP 1
33! Check non-intrinsic calls are OK and check that fix does
34! not confuse result variables.
35  if (any (myfunc (test2(1)) .ne. "ABC")) STOP 2
36contains
37  function myfunc (ch) result (chr)
38    character (*) :: ch(:)
39    character(len(ch)) :: chr(4)
40    if (len (ch) .ne. 3) STOP 3
41    if (any (ch .ne. "ABC")) STOP 4
42    chr = test2 (1)
43    if (len(test2(len(chr))) .ne. 7) STOP 5
44  end function myfunc
45end program test
46
47pure function f(x)
48  integer, intent(in) :: x
49  integer f
50  f = 2*x+1
51end function f
52