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