OSDN Git Service

2007-08-06 Christopher D. Rickett <crickett@lanl.gov>
authorkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 7 Aug 2007 00:27:25 +0000 (00:27 +0000)
committerkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Tue, 7 Aug 2007 00:27:25 +0000 (00:27 +0000)
        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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127265 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/trans-decl.c
gcc/fortran/trans-expr.c
gcc/fortran/trans.h

index dc5a09e..438fde0 100644 (file)
@@ -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
index c9a195f..845bbf1 100644 (file)
@@ -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
index 17cf734..674448b 100644 (file)
@@ -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
index 8226187..645f9a3 100644 (file)
@@ -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.  */