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

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

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;

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

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.

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 *);

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

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;
+}