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.

4 files changed, 49 insertions, 57 deletions

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cb7f684..d288af5 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -6001,15 +6001,20 @@ generate_local_decl (gfc_symbol * sym)
 
   if (sym->attr.dummy == 1)
     {
-      /* Modify the tree type for scalar character dummy arguments of bind(c)
-	 procedures if they are passed by value.  The tree type for them will
-	 be promoted to INTEGER_TYPE for the middle end, which appears to be
-	 what C would do with characters passed by-value.  The value attribute
-         implies the dummy is a scalar.  */
+      /* The tree type for scalar character dummy arguments of BIND(C)
+	 procedures, if they are passed by value, should be unsigned char.
+	 The value attribute implies the dummy is a scalar.  */
       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)
-	gfc_conv_scalar_char_value (sym, NULL, NULL);
+	{
+	  /* 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.  */
+	  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);
+	}
 
       /* Unused procedure passed as dummy argument.  */
       if (sym->attr.flavor == FL_PROCEDURE)
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);
 		    }
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index eec4aa6..6262d52 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2262,7 +2262,7 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
 
   if (sym->ts.type == BT_CHARACTER
       && ((sym->attr.function && sym->attr.is_bind_c)
-	  || (sym->attr.result
+	  || ((sym->attr.result || sym->attr.value)
 	      && sym->ns->proc_name
 	      && sym->ns->proc_name->attr.is_bind_c)
 	  || (sym->ts.deferred && (!sym->ts.u.cl
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 15012a3..f78d502 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -508,7 +508,6 @@ void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
 tree gfc_get_character_len_in_bytes (tree);
 tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
 tree gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *, gfc_expr *);
-void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr);
 tree gfc_string_to_single_character (tree len, tree str, int kind);
 tree gfc_get_tree_for_caf_expr (gfc_expr *);
 void gfc_get_caf_token_offset (gfc_se*, tree *, tree *, tree, tree, gfc_expr *);