mirror of git://gcc.gnu.org/git/gcc.git
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
This commit is contained in:
Tobias Burnus
Tobias Burnus
parent
ac605fd66d
commit
7861a5ce14
|
|
@ -1,3 +1,11 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -1,3 +1,10 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -71,3 +71,5 @@ contains
|
|||
func4ent = -88.0
|
||||
end function func4
|
||||
end module mod
|
||||
|
||||
! { dg-final { cleanup-modules "mod" } }
|
||||
|
|
|
|||
|
|
@ -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" } }
|
||||
|
|
@ -0,0 +1,115 @@
|
|||
! { 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" } }
|
||||
Loading…
Reference in New Issue