From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001 From: upstream source tree Date: Sun, 15 Mar 2015 20:14:05 -0400 Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository. --- gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 | 151 ++++++++++++++++++++++++++ 1 file changed, 151 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 (limited to 'gcc/testsuite/gfortran.dg/bind_c_usage_13.f03') diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 new file mode 100644 index 000000000..d89963d8b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 @@ -0,0 +1,151 @@ +! { 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" } } -- cgit v1.2.3