[Bug fortran/32732] [Bind C] Character scalars are passed as arrays

[Christopher D. Rickett]

hi Steve,

i think it's safe to ignore the fsym->backend_decl if it's null, because, 
in the case of main, it won't have been processed yet.  the 
gfc_conv_scalar_char_value should still be able to at least modify the 
expression for the actual arg in this case.  i've attached a new patch for 
trans-expr.c that now generates the following dump for MAIN__ in value_6:

MAIN__ ()
{
   static int4 options.3[7] = {68, 127, 0, 0, 0, 1, 0};

   _gfortran_set_options (7, (void *) &options.3);
   test (97);
}

please give the attached patch a try.  i have NOT regtested it, but plan 
to now.  the new patch may conflict with the previous one, so it may be 
simpler to modify the few lines by hand, or revert the other.

thanks.
Chris

On Thu, 2 Aug 2007, Christopher D. Rickett wrote:

> hi Steve,
>
> thanks for looking into this.  i'm seeing the same problem.  the following is 
> what -fdump-tree-original gives for MAIN__ for value_6:
>
> MAIN__ ()
> {
>  static int4 options.3[7] = {68, 127, 0, 0, 0, 1, 0};
>
>  _gfortran_set_options (7, (void *) &options.3);
>  test ("a", 1);
> }
>
> i'll see if i can find a way around this.
> Chris
>
> On Thu, 2 Aug 2007, Steve Ellcey wrote:
>
>> So I did some investigating into why this patch didn't fix value_6.f03.
>> It looks like the problem is with the call from main to test.  Main is
>> still passing 'a' as an array of char instead of just a char.
>> 
>> It looks like gfc_conv_function_call is not calling
>> gfc_conv_scalar_char_value at the call to test in this test case.
>> Looking at the if statement protecting that call, I see:
>>
>>                  if (fsym->ts.type == BT_CHARACTER             /* TRUE */
>>                      && fsym->backend_decl != NULL             /* FALSE */
>>                      && fsym->ts.is_c_interop                  /* TRUE */
>>                      && fsym->ns->proc_name != NULL            /* TRUE */
>>                      && fsym->ns->proc_name->attr.is_bind_c)   /* TRUE */
>> 
>> So the problem is that fsym->backend_decl is NULL.  I am not sure how
>> to address this.
>> 
>> Steve Ellcey
>> sje@cup.hp.com
>> 
>
-------------- next part --------------
Index: trans-expr.c
===================================================================
--- trans-expr.c	(revision 127065)
+++ trans-expr.c	(working copy)
@@ -1210,6 +1210,59 @@ gfc_to_single_character (tree len, tree 
   return NULL_TREE;
 }
 
+
+void
+gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr)
+{
+  gfc_expr *tmp_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)
+        {
+	  tmp_expr = *expr;
+	  *expr = gfc_int_expr ((int)tmp_expr->value.character.string[0]);
+	}
+      else if (se != NULL && (*expr)->expr_type == EXPR_VARIABLE)
+        {
+	  if ((*expr)->ref == NULL)
+	    {
+	      tmp_expr = *expr;
+	      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));
+	    }
+	}
+    }
+  
+  return;
+}
+
+
 /* Compare two strings. If they are all single characters, the result is the
    subtraction of them. Otherwise, we build a library call.  */
 
@@ -2167,6 +2220,17 @@ gfc_conv_function_call (gfc_se * se, gfc
             {
 	      if (fsym && fsym->attr.value)
 		{
+		  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] == '%')