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

7 files changed, 289 insertions, 4 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 74e5df0..43f6229 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 4b114df..3a38973 100644
--- a/gcc/fortran/trans-decl.c
+++ b/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);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c15de4b..6fc1e2c 100644
--- a/gcc/fortran/trans-expr.c
+++ b/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);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0899790..7380eb8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03
index c6f2b79..4f2268a 100644
--- a/gcc/testsuite/gfortran.dg/bind_c_usage_10.f03
+++ b/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" } }
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 0000000..d89963d
--- /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" } }
diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03
new file mode 100644
index 0000000..abcc46e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_14.f03
@@ -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" } }