[Patch, Fortran] PR34079 - BIND(C) and characters - unneeded character length passed

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

For
   call subroutine("Hello")
gfortran passes two arguments: a pointer to the string and the string
length. For C interoperability the additional argument with the
character length is not needed.

This patch simply does not generate the extra argument(s) when calling a
BIND(C) procedure.

The extra argument is harmless for the standard C calling convention as
the caller pops the stack, however, using STDCALL the called function
has to pop the stack.

STDCALL is used by some 32bit Windows libraries and I don't know how
much this patch will help.
(For STDCALL see -mrdt option in the GCC manual and
http://gcc.gnu.org/ml/fortran/2007-11/msg00074.html )


Build and regression tested on x86-64. OK for the trunk?

Tobias

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

	PR fortran/34079
	* trans-expr.c (gfc_conv_function_call): Only generate string length
	argument when calling non-BIND(C) procedures.

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

	PR fortran/34079
	* gfortran.dg/bind_c_vars_2.f90: New.

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 130198)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -2390,8 +2390,8 @@ gfc_conv_function_call (gfc_se * se, gfc
         }
 
       /* 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);
Index: gcc/testsuite/gfortran.dg/bind_c_vars_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/bind_c_vars_2.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/bind_c_vars_2.f90	(Revision 0)
@@ -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" } }