1! { dg-do run }
2! Tests the fix for PR36433 in which a check for the array size
3! or character length of the actual arguments of foo and bar
4! would reject this legal code.
5!
6! Contributed by Paul Thomas <pault@gcc.gnu.org>
7!
8module m
9contains
10  function proc4 (arg, chr)
11    integer, dimension(10) :: proc4
12    integer, intent(in) :: arg
13    character(8), intent(inout) :: chr
14    proc4 = arg
15    chr = "proc4"
16  end function
17  function chr_proc ()
18    character(8) :: chr_proc
19    chr_proc = "chr_proc"
20  end function
21end module
22
23program procPtrTest
24  use m
25  character(8) :: chr
26  interface
27    function proc_ext (arg, chr)
28      integer, dimension(10) :: proc_ext
29      integer, intent(in) :: arg
30      character(8), intent(inout) :: chr
31    end function
32  end interface
33! Check the passing of a module function
34  call foo (proc4, chr)
35  if (trim (chr) .ne. "proc4") call abort
36! Check the passing of an external function
37  call foo (proc_ext, chr)
38! Check the passing of a character function
39  if (trim (chr) .ne. "proc_ext") call abort
40  call bar (chr_proc)
41contains
42  subroutine foo (p, chr)
43    character(8), intent(inout) :: chr
44    integer :: i(10)
45    interface
46      function p (arg, chr)
47        integer, dimension(10) :: p
48        integer, intent(in) :: arg
49        character(8), intent(inout) :: chr
50      end function
51    end interface
52    i = p (99, chr)
53    if (any(i .ne. 99)) call abort
54  end subroutine
55  subroutine bar (p)
56    interface
57      function p ()
58        character(8):: p
59      end function
60    end interface
61    if (p () .ne. "chr_proc") call abort
62  end subroutine
63end program
64
65function proc_ext (arg, chr)
66  integer, dimension(10) :: proc_ext
67  integer, intent(in) :: arg
68  character(8), intent(inout) :: chr
69  proc_ext = arg
70  chr = "proc_ext"
71end function
72