re PR fortran/32732 ([Bind C] Character scalars are passed as arrays)

2007-08-06  Christopher D. Rickett  <crickett@lanl.gov>

        PR fortran/32732
        * trans-expr.c (gfc_conv_scalar_char_value): Convert the tree and
        actual arg expressions for scalar characters passed by-value to
        bind(c) routines.
        (gfc_conv_function_call): Call gfc_conv_scalar_char_value.
        * trans.h: Add prototype for gfc_conv_scalar_char_value.
        * trans-decl.c (generate_local_decl): Convert by-value character
        dummy args of bind(c) procedures using
        gfc_conv_scalar_char_value.

From-SVN: r127265

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index dc5a09e2dc0cf06bb6a4f4248d6bfe498ba97ceb..438fde0fd774c0fe9038a5bb46a5dffd858ba03a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2007-08-06  Christopher D. Rickett  <crickett@lanl.gov>
+
+       PR fortran/32732
+       * trans-expr.c (gfc_conv_scalar_char_value): Convert the tree and
+       actual arg expressions for scalar characters passed by-value to
+       bind(c) routines.
+       (gfc_conv_function_call): Call gfc_conv_scalar_char_value.
+       * trans.h: Add prototype for gfc_conv_scalar_char_value.
+       * trans-decl.c (generate_local_decl): Convert by-value character
+       dummy args of bind(c) procedures using
+       gfc_conv_scalar_char_value.
+
 2007-08-06  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        PR fortran/30947

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c9a195fe7843882153c116ef4a4ae924b7acc348..845bbf1b3ed7bf0df8593d504acf264a2606fbd9 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -3055,7 +3055,7 @@ generate_local_decl (gfc_symbol * sym)
       if (sym->attr.value == 1 && sym->backend_decl != NULL
          && sym->ts.type == BT_CHARACTER && sym->ts.is_c_interop
          && sym->ns->proc_name != NULL && sym->ns->proc_name->attr.is_bind_c)
-       TREE_TYPE (sym->backend_decl) = unsigned_char_type_node;
+       gfc_conv_scalar_char_value (sym, NULL, NULL);
     }
 
   /* Make sure we convert the types of the derived types from iso_c_binding

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 17cf7344e8d7a50e7e02585d3881e2eb0300ba16..674448b7a448ebb2abf18dea22c425c22abb0c45 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1209,6 +1209,64 @@ gfc_to_single_character (tree len, tree str)
   return NULL_TREE;
 }
 
+
+void
+gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr)
+{
+
+  if (sym->backend_decl)
+    {
+      /* This becomes the nominal_type in
+        function.c:assign_parm_find_data_types.  */
+      TREE_TYPE (sym->backend_decl) = unsigned_char_type_node;
+      /* This becomes the passed_type in
+        function.c:assign_parm_find_data_types.  C promotes char to
+        integer for argument passing.  */
+      DECL_ARG_TYPE (sym->backend_decl) = unsigned_type_node;
+
+      DECL_BY_REFERENCE (sym->backend_decl) = 0;
+    }
+
+  if (expr != NULL)
+    {
+      /* If we have a constant character expression, make it into an
+        integer.  */
+      if ((*expr)->expr_type == EXPR_CONSTANT)
+        {
+         gfc_typespec ts;
+
+         *expr = gfc_int_expr ((int)(*expr)->value.character.string[0]);
+         if ((*expr)->ts.kind != gfc_c_int_kind)
+           {
+             /* The expr needs to be compatible with a C int.  If the 
+                conversion fails, then the 2 causes an ICE.  */
+             ts.type = BT_INTEGER;
+             ts.kind = gfc_c_int_kind;
+             gfc_convert_type (*expr, &ts, 2);
+           }
+       }
+      else if (se != NULL && (*expr)->expr_type == EXPR_VARIABLE)
+        {
+         if ((*expr)->ref == NULL)
+           {
+             se->expr = gfc_to_single_character
+               (build_int_cst (integer_type_node, 1),
+                gfc_build_addr_expr (pchar_type_node,
+                                     gfc_get_symbol_decl
+                                     ((*expr)->symtree->n.sym)));
+           }
+         else
+           {
+             gfc_conv_variable (se, *expr);
+             se->expr = gfc_to_single_character
+               (build_int_cst (integer_type_node, 1),
+                gfc_build_addr_expr (pchar_type_node, se->expr));
+           }
+       }
+    }
+}
+
+
 /* Compare two strings. If they are all single characters, the result is the
    subtraction of them. Otherwise, we build a library call.  */
 
@@ -2166,7 +2224,18 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
             {
              if (fsym && fsym->attr.value)
                {
-                 gfc_conv_expr (&parmse, e);
+                 if (fsym->ts.type == BT_CHARACTER
+                     && fsym->ts.is_c_interop
+                     && fsym->ns->proc_name != NULL
+                     && fsym->ns->proc_name->attr.is_bind_c)
+                   {
+                     parmse.expr = NULL;
+                     gfc_conv_scalar_char_value (fsym, &parmse, &e);
+                     if (parmse.expr == NULL)
+                       gfc_conv_expr (&parmse, e);
+                   }
+                 else
+                   gfc_conv_expr (&parmse, e);
                }
              else if (arg->name && arg->name[0] == '%')
                /* Argument list functions %VAL, %LOC and %REF are signalled

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 8226187f78c6ac6f4a7567939b4fa2a8eace426e..645f9a3d78d26db6fe0830e67d66ec160f9d16df 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -295,6 +295,9 @@ void gfc_conv_expr_lhs (gfc_se * se, gfc_expr * expr);
 void gfc_conv_expr_reference (gfc_se * se, gfc_expr *);
 void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
 
+/* trans-expr.c */
+void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr);
+
 /* Find the decl containing the auxiliary variables for assigned variables.  */
 void gfc_conv_label_variable (gfc_se * se, gfc_expr * expr);
 /* If the value is not constant, Create a temporary and copy the value.  */