blob: ff1e31d345f6e9887b0ca2f744f4619bd7f9c435 [file] [log] [blame]
! PR92482
! { dg-do run }
! { dg-additional-sources "cf-out-descriptor-5-c.c dump-descriptors.c" }
! { dg-additional-options "-g" }
!
! This program checks use of an assumed-length character dummy argument
! as an intent(out) parameter in subroutines with C binding.
subroutine ftest (a, n) bind (c, name="ftest") ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
use iso_c_binding
character(kind=C_CHAR, len=*), intent(out) :: a
integer(C_INT), value :: n
if (len (a) .ne. n) stop 101
a = 'abcdefghijklmnopqrstuvwxyz'
end subroutine
program testit
use iso_c_binding
implicit none
interface
subroutine ctest (a, n) bind (c) ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
use iso_c_binding
character(kind=C_CHAR, len=*), intent(out) :: a
integer(C_INT), value :: n
end subroutine
subroutine ftest (a, n) bind (c) ! { dg-bogus "Sorry" "pr92482" { xfail *-*-* } }
use iso_c_binding
character(kind=C_CHAR, len=*), intent(out) :: a
integer(C_INT), value :: n
end subroutine
end interface
character(kind=C_CHAR, len=42) :: aa
! call ftest directly
aa = '12345678910'
call ftest (aa, 42)
print *, aa
! ctest calls ftest indirectly
aa = '12345678910'
call ctest (aa, 42)
print *, aa
end program