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

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

        PR fortran/34079
        * trans-types.c (gfc_return_by_reference,
        gfc_get_function_type): Do not return result of
        character-returning bind(C) functions as argument.
        * trans-expr.c (gfc_conv_function_call): Ditto.

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

        PR fortran/34079
        * gfortran.dg/bind_c_usage_10_c.c: Fix comment.
        * gfortran.dg/bind_c_usage_16.f03: New.
        * gfortran.dg/bind_c_usage_16_c.c: New.

From-SVN: r130414

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 94ebe8e54bef45a72dcb8b4f7a2f5888eb83ab53..2b4799af88e376eed3f3d11a34f5290750506aa0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2007-11-25  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34079
+       * trans-types.c (gfc_return_by_reference,
+       gfc_get_function_type): Do not return result of
+       character-returning bind(C) functions as argument.
+       * trans-expr.c (gfc_conv_function_call): Ditto.
+
 2007-11-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/34175

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 231fef5bf7bdd58ebd632e95b74909107f2fa4b7..813e43da2db808c9a5932558841fb3b4495d723d 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2586,6 +2586,15 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
       && !sym->attr.always_explicit)
     se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
 
+  /* Bind(C) character variables may have only length 1.  */
+  if (sym->ts.type == BT_CHARACTER && sym->attr.is_bind_c)
+    {
+      gcc_assert (sym->ts.cl->length
+                 && sym->ts.cl->length->expr_type == EXPR_CONSTANT
+                 && mpz_cmp_si (sym->ts.cl->length->value.integer, 1));
+      se->string_length = build_int_cst (gfc_charlen_type_node, 1);
+    }
+
   /* A pure function may still have side-effects - it may modify its
      parameters.  */
   TREE_SIDE_EFFECTS (se->expr) = 1;

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 5202539fc507cdecb2f5a5125e5b71fc6e12ba3d..ff5643b0fc3078a8768937ee003bc0c00f2a55b2 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1853,7 +1853,7 @@ gfc_return_by_reference (gfc_symbol * sym)
   if (sym->attr.dimension)
     return 1;
 
-  if (sym->ts.type == BT_CHARACTER)
+  if (sym->ts.type == BT_CHARACTER && !sym->attr.is_bind_c)
     return 1;
 
   /* Possibly return complex numbers by reference for g77 compatibility.
@@ -1942,17 +1942,17 @@ gfc_get_function_type (gfc_symbol * sym)
       typelist = gfc_chainon_list (typelist, gfc_array_index_type);
     }
 
+  if (sym->result)
+    arg = sym->result;
+  else
+    arg = sym;
+
+  if (arg->ts.type == BT_CHARACTER)
+    gfc_conv_const_charlen (arg->ts.cl);
+
   /* Some functions we use an extra parameter for the return value.  */
   if (gfc_return_by_reference (sym))
     {
-      if (sym->result)
-       arg = sym->result;
-      else
-       arg = sym;
-
-      if (arg->ts.type == BT_CHARACTER)
-       gfc_conv_const_charlen (arg->ts.cl);
-
       type = gfc_sym_type (arg);
       if (arg->ts.type == BT_COMPLEX
          || arg->attr.dimension

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6c4f2ac860a16a8cd79e5cf9a85608362637f965..df55de85047d265a31153f1b796fd815e564f35f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2007-11-25  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34079
+       * gfortran.dg/bind_c_usage_10_c.c: Fix comment.
+       * gfortran.dg/bind_c_usage_16.f03: New.
+       * gfortran.dg/bind_c_usage_16_c.c: New.
+
 2007-11-25  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/specs/size_clause1.ads: New test.

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c b/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c
index 91871c770face4518a1b705f550d8dd79aa33be9..ec64c41b00c8b759116f1542c807a11f3c04083f 100644 (file)
--- a/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_10_c.c
@@ -1,6 +1,6 @@
 /* Check BIND(C) for ENTRY
    PR fortran/34079
-   To be linked with bind_c_usage_10.c
+   To be linked with bind_c_usage_10.f03
 */
 
 void mySub1(int *);

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_16.f03 b/gcc/testsuite/gfortran.dg/bind_c_usage_16.f03
new file mode 100644 (file)
index 0000000..b05faa7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_16.f03
@@ -0,0 +1,52 @@
+! { dg-do run }
+! { dg-additional-sources bind_c_usage_16_c.c }
+!
+! PR fortran/34079
+!
+! Ensure character-returning, bind(C) function work.
+!
+module mod
+  use iso_c_binding
+  implicit none
+contains
+  function bar(x)  bind(c, name="returnA")
+    character(len=1,kind=c_char) :: bar, x
+    bar = x
+    bar = 'A'
+  end function bar
+  function foo()  bind(c, name="returnB")
+    character(len=1,kind=c_char) :: foo
+    foo = 'B'
+  end function foo
+end module mod
+
+subroutine test() bind(c)
+  use mod
+  implicit none
+  character(len=1,kind=c_char) :: a
+  character(len=5,kind=c_char) :: b
+  character(len=1,kind=c_char) :: c(3)
+  character(len=5,kind=c_char) :: d(3)
+  a = 'z'
+  b = 'fffff'
+  c = 'h'
+  d = 'uuuuu'
+
+  a = bar('x')
+  if (a /= 'A') call abort()
+  b = bar('y')
+  if (b /= 'A') call abort()
+  c = bar('x')
+  if (any(c /= 'A')) call abort()
+  d = bar('y')
+  if (any(d /= 'A')) call abort()
+
+  a = foo()
+  if (a /= 'B') call abort()
+  b = foo()
+  if (b /= 'B') call abort()
+  c = foo()
+  if (any(c /= 'B')) call abort()
+  d = foo()
+  if (any(d /= 'B')) call abort()
+end subroutine

diff --git a/gcc/testsuite/gfortran.dg/bind_c_usage_16_c.c b/gcc/testsuite/gfortran.dg/bind_c_usage_16_c.c
new file mode 100644 (file)
index 0000000..30ce25f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bind_c_usage_16_c.c
@@ -0,0 +1,22 @@
+/* Check character-returning bind(C) functions
+   PR fortran/34079
+   To be linked with bind_c_usage_16.f03
+*/
+
+#include <stdlib.h>
+
+char returnA(char *);
+char returnB(void);
+void test(void);
+
+int main()
+{
+  char c;
+  c = 'z';
+  c = returnA(&c);
+  if (c != 'A') abort();
+  c = returnB();
+  if (c != 'B') abort();
+  test();
+  return 0;
+}