152 lines
4.9 KiB
Fortran
152 lines
4.9 KiB
Fortran
! { dg-do compile }
|
|
! { dg-options "-fdump-tree-original" }
|
|
!
|
|
! PR fortran/34079
|
|
! Character bind(c) arguments shall not pass the length as additional argument
|
|
!
|
|
|
|
subroutine multiArgTest()
|
|
implicit none
|
|
interface ! Array
|
|
subroutine multiso_array(x,y) bind(c)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1), dimension(*) :: x,y
|
|
end subroutine multiso_array
|
|
subroutine multiso2_array(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
|
|
character(len=1), dimension(*) :: x,y
|
|
end subroutine multiso2_array
|
|
subroutine mult_array(x,y)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1), dimension(*) :: x,y
|
|
end subroutine mult_array
|
|
end interface
|
|
|
|
interface ! Scalar: call by reference
|
|
subroutine multiso(x,y) bind(c)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1) :: x,y
|
|
end subroutine multiso
|
|
subroutine multiso2(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
|
|
character(len=1) :: x,y
|
|
end subroutine multiso2
|
|
subroutine mult(x,y)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1) :: x,y
|
|
end subroutine mult
|
|
end interface
|
|
|
|
interface ! Scalar: call by VALUE
|
|
subroutine multiso_val(x,y) bind(c)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1), value :: x,y
|
|
end subroutine multiso_val
|
|
subroutine multiso2_val(x,y) bind(c) ! { dg-warning "may not be C interoperable" }
|
|
character(len=1), value :: x,y
|
|
end subroutine multiso2_val
|
|
subroutine mult_val(x,y)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1), value :: x,y
|
|
end subroutine mult_val
|
|
end interface
|
|
|
|
call mult_array ("abc","ab")
|
|
call multiso_array ("ABCDEF","ab")
|
|
call multiso2_array("AbCdEfGhIj","ab")
|
|
|
|
call mult ("u","x")
|
|
call multiso ("v","x")
|
|
call multiso2("w","x")
|
|
|
|
call mult_val ("x","x")
|
|
call multiso_val ("y","x")
|
|
call multiso2_val("z","x")
|
|
end subroutine multiArgTest
|
|
|
|
program test
|
|
implicit none
|
|
|
|
interface ! Array
|
|
subroutine subiso_array(x) bind(c)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1), dimension(*) :: x
|
|
end subroutine subiso_array
|
|
subroutine subiso2_array(x) bind(c) ! { dg-warning "may not be C interoperable" }
|
|
character(len=1), dimension(*) :: x
|
|
end subroutine subiso2_array
|
|
subroutine sub_array(x)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1), dimension(*) :: x
|
|
end subroutine sub_array
|
|
end interface
|
|
|
|
interface ! Scalar: call by reference
|
|
subroutine subiso(x) bind(c)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1) :: x
|
|
end subroutine subiso
|
|
subroutine subiso2(x) bind(c) ! { dg-warning "may not be C interoperable" }
|
|
character(len=1) :: x
|
|
end subroutine subiso2
|
|
subroutine sub(x)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1) :: x
|
|
end subroutine sub
|
|
end interface
|
|
|
|
interface ! Scalar: call by VALUE
|
|
subroutine subiso_val(x) bind(c)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1), value :: x
|
|
end subroutine subiso_val
|
|
subroutine subiso2_val(x) bind(c) ! { dg-warning "may not be C interoperable" }
|
|
character(len=1), value :: x
|
|
end subroutine subiso2_val
|
|
subroutine sub_val(x)
|
|
use iso_c_binding
|
|
character(kind=c_char,len=1), value :: x
|
|
end subroutine sub_val
|
|
end interface
|
|
|
|
call sub_array ("abc")
|
|
call subiso_array ("ABCDEF")
|
|
call subiso2_array("AbCdEfGhIj")
|
|
|
|
call sub ("u")
|
|
call subiso ("v")
|
|
call subiso2("w")
|
|
|
|
call sub_val ("x")
|
|
call subiso_val ("y")
|
|
call subiso2_val("z")
|
|
end program test
|
|
|
|
! Double argument dump:
|
|
!
|
|
! { dg-final { scan-tree-dump "mult_array .&.abc..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1., 3, 2.;" "original" } }
|
|
! { dg-final { scan-tree-dump "multiso_array .&.ABCDEF..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }
|
|
! { dg-final { scan-tree-dump "multiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } }
|
|
!
|
|
! { dg-final { scan-tree-dump "mult .&.u..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1., 1, 1.;" "original" } }
|
|
! { dg-final { scan-tree-dump "multiso .&.v..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
|
|
! { dg-final { scan-tree-dump "multiso2 .&.w..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } }
|
|
!
|
|
! { dg-final { scan-tree-dump "mult_val ..x., .x., 1, 1.;" "original" } }
|
|
! { dg-final { scan-tree-dump "multiso_val .121, 120.;" "original" } }
|
|
! { dg-final { scan-tree-dump "multiso2_val ..z., .x..;" "original" } }
|
|
!
|
|
! Single argument dump:
|
|
!
|
|
! { dg-final { scan-tree-dump "sub_array .&.abc..1..lb: 1 sz: 1., 3.;" "original" } }
|
|
! { dg-final { scan-tree-dump "subiso_array .&.ABCDEF..1..lb: 1 sz: 1..;" "original" } }
|
|
! { dg-final { scan-tree-dump "subiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1..;" "original" } }
|
|
!
|
|
! { dg-final { scan-tree-dump "sub .&.u..1..lb: 1 sz: 1., 1.;" "original" } }
|
|
! { dg-final { scan-tree-dump "subiso .&.v..1..lb: 1 sz: 1..;" "original" } }
|
|
! { dg-final { scan-tree-dump "subiso2 .&.w..1..lb: 1 sz: 1..;" "original" } }
|
|
!
|
|
! { dg-final { scan-tree-dump "sub_val ..x., 1.;" "original" } }
|
|
! { dg-final { scan-tree-dump "subiso_val .121.;" "original" } }
|
|
! { dg-final { scan-tree-dump "subiso2_val ..z..;" "original" } }
|
|
!
|
|
! { dg-final { cleanup-tree-dump "original" } }
|