! { dg-do run }
|
! { dg-do run }
|
! Tests the fix for PR36433 in which a check for the array size
|
! Tests the fix for PR36433 in which a check for the array size
|
! or character length of the actual arguments of foo and bar
|
! or character length of the actual arguments of foo and bar
|
! would reject this legal code.
|
! would reject this legal code.
|
!
|
!
|
! Contributed by Paul Thomas
|
! Contributed by Paul Thomas
|
!
|
!
|
module m
|
module m
|
contains
|
contains
|
function proc4 (arg, chr)
|
function proc4 (arg, chr)
|
integer, dimension(10) :: proc4
|
integer, dimension(10) :: proc4
|
integer, intent(in) :: arg
|
integer, intent(in) :: arg
|
character(8), intent(inout) :: chr
|
character(8), intent(inout) :: chr
|
proc4 = arg
|
proc4 = arg
|
chr = "proc4"
|
chr = "proc4"
|
end function
|
end function
|
function chr_proc ()
|
function chr_proc ()
|
character(8) :: chr_proc
|
character(8) :: chr_proc
|
chr_proc = "chr_proc"
|
chr_proc = "chr_proc"
|
end function
|
end function
|
end module
|
end module
|
|
|
program procPtrTest
|
program procPtrTest
|
use m
|
use m
|
character(8) :: chr
|
character(8) :: chr
|
interface
|
interface
|
function proc_ext (arg, chr)
|
function proc_ext (arg, chr)
|
integer, dimension(10) :: proc_ext
|
integer, dimension(10) :: proc_ext
|
integer, intent(in) :: arg
|
integer, intent(in) :: arg
|
character(8), intent(inout) :: chr
|
character(8), intent(inout) :: chr
|
end function
|
end function
|
end interface
|
end interface
|
! Check the passing of a module function
|
! Check the passing of a module function
|
call foo (proc4, chr)
|
call foo (proc4, chr)
|
if (trim (chr) .ne. "proc4") call abort
|
if (trim (chr) .ne. "proc4") call abort
|
! Check the passing of an external function
|
! Check the passing of an external function
|
call foo (proc_ext, chr)
|
call foo (proc_ext, chr)
|
! Check the passing of a character function
|
! Check the passing of a character function
|
if (trim (chr) .ne. "proc_ext") call abort
|
if (trim (chr) .ne. "proc_ext") call abort
|
call bar (chr_proc)
|
call bar (chr_proc)
|
contains
|
contains
|
subroutine foo (p, chr)
|
subroutine foo (p, chr)
|
character(8), intent(inout) :: chr
|
character(8), intent(inout) :: chr
|
integer :: i(10)
|
integer :: i(10)
|
interface
|
interface
|
function p (arg, chr)
|
function p (arg, chr)
|
integer, dimension(10) :: p
|
integer, dimension(10) :: p
|
integer, intent(in) :: arg
|
integer, intent(in) :: arg
|
character(8), intent(inout) :: chr
|
character(8), intent(inout) :: chr
|
end function
|
end function
|
end interface
|
end interface
|
i = p (99, chr)
|
i = p (99, chr)
|
if (any(i .ne. 99)) call abort
|
if (any(i .ne. 99)) call abort
|
end subroutine
|
end subroutine
|
subroutine bar (p)
|
subroutine bar (p)
|
interface
|
interface
|
function p ()
|
function p ()
|
character(8):: p
|
character(8):: p
|
end function
|
end function
|
end interface
|
end interface
|
if (p () .ne. "chr_proc") call abort
|
if (p () .ne. "chr_proc") call abort
|
end subroutine
|
end subroutine
|
end program
|
end program
|
|
|
function proc_ext (arg, chr)
|
function proc_ext (arg, chr)
|
integer, dimension(10) :: proc_ext
|
integer, dimension(10) :: proc_ext
|
integer, intent(in) :: arg
|
integer, intent(in) :: arg
|
character(8), intent(inout) :: chr
|
character(8), intent(inout) :: chr
|
proc_ext = arg
|
proc_ext = arg
|
chr = "proc_ext"
|
chr = "proc_ext"
|
end function
|
end function
|
|
|
