Skip to content

R
riscv-gcc-1
Commit 7861a5ce by Tobias Burnus Committed by Tobias Burnus
Options

re PR fortran/34079 (Bind(C): Character argument/return value problems) 

2007-11-22  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34079
        * trans-expr.c (gfc_conv_function_call): Do not append
        string length arguments when calling bind(c) procedures.
        * trans-decl.c (create_function_arglist): Do not append
        string length arguments when declaring bind(c) procedures.

2007-11-22  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34079
        * gfortran.dg/bind_c_usage_10.f03: Remove .mod file afterwards.
        * gfortran.dg/bind_c_usage_13.f03: New.
        * gfortran.dg/bind_c_usage_14.f03: New.

From-SVN: r130346
parent ac605fd6
Showing with 289 additions and 4 deletions
gcc/fortran/ChangeLog
2007-11-22 Tobias Burnus <burnus@net-b.de>
PR fortran/34079
* trans-expr.c (gfc_conv_function_call): Do not append
string length arguments when calling bind(c) procedures.
* trans-decl.c (create_function_arglist): Do not append
string length arguments when declaring bind(c) procedures.
2007-11-21 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/34083
......
gcc/fortran/trans-decl.c
......@@ -1535,8 +1535,10 @@ create_function_arglist (gfc_symbol * sym)
typelist = TREE_CHAIN (typelist);
}
/* Add the hidden string length parameters. */
arglist = chainon (arglist, hidden_arglist);
/* Add the hidden string length parameters, unless the procedure
is bind(C). */
if (!sym->attr.is_bind_c)
arglist = chainon (arglist, hidden_arglist);
gcc_assert (hidden_typelist == NULL_TREE
|| TREE_VALUE (hidden_typelist) == void_type_node);
......
gcc/fortran/trans-expr.c
......@@ -2392,8 +2392,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
}
/* Character strings are passed as two parameters, a length and a
pointer. */
if (parmse.string_length != NULL_TREE)
pointer - except for Bind(c) which only passes the pointer. */
if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
stringargs = gfc_chainon_list (stringargs, parmse.string_length);
arglist = gfc_chainon_list (arglist, parmse.expr);
......
gcc/testsuite/ChangeLog
2007-11-22 Tobias Burnus <burnus@net-b.de>
PR fortran/34079
* gfortran.dg/bind_c_usage_10.f03: Remove .mod file afterwards.
* gfortran.dg/bind_c_usage_13.f03: New.
* gfortran.dg/bind_c_usage_14.f03: New.
2007-11-22 Richard Sandiford <rsandifo@nildram.co.uk>
PR rtl-optimization/33848
gcc/testsuite/gfortran.dg/bind_c_usage_10.f03
......@@ -71,3 +71,5 @@ contains
func4ent = -88.0
end function func4
end module mod
! { dg-final { cleanup-modules "mod" } }
gcc/testsuite/gfortran.dg/bind_c_usage_13.f03 0 → 100644
! { 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" } }
gcc/testsuite/gfortran.dg/bind_c_usage_14.f03 0 → 100644
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
!
! PR fortran/34079
! Bind(C) procedures shall have no character length
! dummy and actual arguments.
!
! SUBROUTINES
subroutine sub1noiso(a, b)
use iso_c_binding
implicit none
character(len=1,kind=c_char) :: a(*), b
character(len=1,kind=c_char):: x,z
integer(c_int) :: y
value :: b
print *, a(1:2), b
end subroutine sub1noiso
subroutine sub2(a, b) bind(c)
use iso_c_binding
implicit none
character(len=1,kind=c_char) :: a(*), b
character(len=1,kind=c_char):: x,z
integer(c_int) :: y
value :: b
print *, a(1:2), b
end subroutine sub2
! SUBROUTINES with ENTRY
subroutine sub3noiso(a, b)
use iso_c_binding
implicit none
character(len=1,kind=c_char) :: a(*), b
character(len=1,kind=c_char):: x,z
integer(c_int) :: y
value :: b
print *, a(1:2), b
entry sub3noisoEntry(x,y,z)
x = 'd'
end subroutine sub3noiso
subroutine sub4iso(a, b) bind(c)
use iso_c_binding
implicit none
character(len=1,kind=c_char) :: a(*), b
character(len=1,kind=c_char):: x,z
integer(c_int) :: y
value :: b
print *, a(1:2), b
entry sub4isoEntry(x,y,z)
x = 'd'
end subroutine sub4iso
subroutine sub5iso(a, b) bind(c)
use iso_c_binding
implicit none
character(len=1,kind=c_char) :: a(*), b
character(len=1,kind=c_char):: x,z
integer(c_int) :: y
value :: b
print *, a(1:2), b
entry sub5noIsoEntry(x,y,z)
x = 'd'
end subroutine sub5iso
subroutine sub6NoIso(a, b)
use iso_c_binding
implicit none
character(len=1,kind=c_char) :: a(*), b
character(len=1,kind=c_char):: x,z
integer(c_int) :: y
value :: b
print *, a(1:2), b
entry sub6isoEntry(x,y,z)
x = 'd'
end subroutine sub6NoIso
! The subroutines (including entry) should have
! only a char-length parameter if they are not bind(C).
!
! { dg-final { scan-tree-dump "sub1noiso .a, b, _a, _b\\)" "original" } }
! { dg-final { scan-tree-dump "sub2 .a, b\\)" "original" } }
! { dg-final { scan-tree-dump "sub3noiso .a, b, _a, _b\\)" "original" } }
! { dg-final { scan-tree-dump "sub3noisoentry .x, y, z, _x, _z\\)" "original" } }
! { dg-final { scan-tree-dump "sub4iso .a, b\\)" "original" } }
! { dg-final { scan-tree-dump "sub4isoentry .x, y, z, _x, _z\\)" "original" } }
! { dg-final { scan-tree-dump "sub5iso .a, b\\)" "original" } }
! { dg-final { scan-tree-dump "sub5noisoentry .x, y, z, _x, _z\\)" "original" } }
! { dg-final { scan-tree-dump "sub6noiso .a, b, _a, _b\\)" "original" } }
! { dg-final { scan-tree-dump "sub6isoentry .x, y, z, _x, _z\\)" "original" } }
! The master functions should have always a length parameter
! to ensure sharing a parameter between bind(C) and non-bind(C) works
!
! { dg-final { scan-tree-dump "master.0.sub3noiso .__entry, z, y, x, b, a, _z, _x, _b, _a\\)" "original" } }
! { dg-final { scan-tree-dump "master.1.sub4iso .__entry, z, y, x, b, a, _z, _x, _b, _a\\)" "original" } }
! { dg-final { scan-tree-dump "master.2.sub5iso .__entry, z, y, x, b, a, _z, _x, _b, _a\\)" "original" } }
! { dg-final { scan-tree-dump "master.3.sub6noiso .__entry, z, y, x, b, a, _z, _x, _b, _a\\)" "original" } }
! Thus, the master functions need to be called with length arguments
! present
!
! { dg-final { scan-tree-dump "master.0.sub3noiso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
! { dg-final { scan-tree-dump "master.0.sub3noiso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
! { dg-final { scan-tree-dump "master.1.sub4iso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
! { dg-final { scan-tree-dump "master.1.sub4iso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
! { dg-final { scan-tree-dump "master.2.sub5iso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
! { dg-final { scan-tree-dump "master.2.sub5iso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
! { dg-final { scan-tree-dump "master.3.sub6noiso .0, 0B, 0B, 0B, b, a, 0, 0, 1, 1\\);" "original" } }
! { dg-final { scan-tree-dump "master.3.sub6noiso .1, z, y, x, 0B, 0B, 1, 1, 0, 0\\);" "original" } }
! { dg-final { cleanup-tree-dump "original" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment