Fortran: Emit correct types for CHARACTER(C_CHAR), VALUE arguments

Make the front-end emit the right type for CHARACTER(C_CHAR), VALUE
arguments to BIND(C) procedures. They are scalar integers of C type
char, and should be emitted as such. They are not strings or arrays,
and are not promoted to C int, either.

gcc/fortran/ChangeLog:

	PR fortran/103828
	* trans-decl.c (generate_local_decl): Do not call
	gfc_conv_scalar_char_value(), but check the type tree.
	* trans-expr.c (gfc_conv_scalar_char_value): Rename to
	conv_scalar_char_value, do not alter type tree.
	(gfc_conv_procedure_call): Adjust call to renamed
	conv_scalar_char_value() function.
	* trans-types.c (gfc_sym_type): Take care of
	CHARACTER(C_CHAR), VALUE arguments.
	* trans.h (gfc_conv_scalar_char_value): Remove prototype.

gcc/testsuite/ChangeLog:

	PR fortran/103828
	* gfortran.dg/c_char_tests_3.f90: New file.
	* gfortran.dg/c_char_tests_3_c.c: New file.
	* gfortran.dg/c_char_tests_4.f90: New file.
	* gfortran.dg/c_char_tests_5.f90: New file.

1 files changed, 37 insertions, 49 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e413b2d..80c669f 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -41,6 +41,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-stmt.h"
 #include "dependency.h"
 #include "gimplify.h"
+#include "tm.h"		/* For CHAR_TYPE_SIZE.  */
 
 
 /* Calculate the number of characters in a string.  */
@@ -3972,63 +3973,50 @@ gfc_string_to_single_character (tree len, tree str, int kind)
 }
 
 
-void
-gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr)
+static void
+conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr)
 {
+  gcc_assert (expr);
 
+  /* We used to modify the tree here. Now it is done earlier in
+     the front-end, so we only check it here to avoid regressions.  */
   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;
+      gcc_assert (TREE_CODE (TREE_TYPE (sym->backend_decl)) == INTEGER_TYPE);
+      gcc_assert (TYPE_UNSIGNED (TREE_TYPE (sym->backend_decl)) == 1);
+      gcc_assert (TYPE_PRECISION (TREE_TYPE (sym->backend_decl)) == CHAR_TYPE_SIZE);
+      gcc_assert (DECL_BY_REFERENCE (sym->backend_decl) == 0);
     }
 
-  if (expr != NULL)
+  /* If we have a constant character expression, make it into an
+      integer of type C char.  */
+  if ((*expr)->expr_type == EXPR_CONSTANT)
     {
-      /* If we have a constant character expression, make it into an
-	 integer.  */
-      if ((*expr)->expr_type == EXPR_CONSTANT)
-        {
-	  gfc_typespec ts;
-          gfc_clear_ts (&ts);
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
 
-	  *expr = gfc_get_int_expr (gfc_default_integer_kind, NULL,
-				    (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);
-	    }
+      *expr = gfc_get_int_expr (gfc_default_character_kind, NULL,
+				(*expr)->value.character.string[0]);
+    }
+  else if (se != NULL && (*expr)->expr_type == EXPR_VARIABLE)
+    {
+      if ((*expr)->ref == NULL)
+	{
+	  se->expr = gfc_string_to_single_character
+	    (build_int_cst (integer_type_node, 1),
+	      gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind),
+				  gfc_get_symbol_decl
+				  ((*expr)->symtree->n.sym)),
+	      (*expr)->ts.kind);
 	}
-      else if (se != NULL && (*expr)->expr_type == EXPR_VARIABLE)
-        {
-	  if ((*expr)->ref == NULL)
-	    {
-	      se->expr = gfc_string_to_single_character
-		(build_int_cst (integer_type_node, 1),
-		 gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind),
-				      gfc_get_symbol_decl
-				      ((*expr)->symtree->n.sym)),
-		 (*expr)->ts.kind);
-	    }
-	  else
-	    {
-	      gfc_conv_variable (se, *expr);
-	      se->expr = gfc_string_to_single_character
-		(build_int_cst (integer_type_node, 1),
-		 gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind),
-				      se->expr),
-		 (*expr)->ts.kind);
-	    }
+      else
+	{
+	  gfc_conv_variable (se, *expr);
+	  se->expr = gfc_string_to_single_character
+	    (build_int_cst (integer_type_node, 1),
+	      gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind),
+				  se->expr),
+	      (*expr)->ts.kind);
 	}
     }
 }
@@ -6341,7 +6329,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		      && fsym->ns->proc_name->attr.is_bind_c)
 		    {
 		      parmse.expr = NULL;
-		      gfc_conv_scalar_char_value (fsym, &parmse, &e);
+		      conv_scalar_char_value (fsym, &parmse, &e);
 		      if (parmse.expr == NULL)
 			gfc_conv_expr (&parmse, e);
 		    }