From 8950288333162caa68b85c71ed2d02f40976ddb9 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 17 Oct 2022 18:15:16 +0200
Subject: Fortran: Fixes for kind=4 characters strings [PR107266]

	PR fortran/107266

gcc/fortran/
	* trans-expr.cc (gfc_conv_string_parameter): Use passed
	type to honor character kind.
	* trans-types.cc (gfc_sym_type): Honor character kind.
	* trans-decl.cc (gfc_conv_cfi_to_gfc): Fix handling kind=4
	character strings.

gcc/testsuite/
	* gfortran.dg/char4_decl.f90: New test.
	* gfortran.dg/char4_decl-2.f90: New test.
---
 gcc/fortran/trans-decl.cc  | 10 +++++-----
 gcc/fortran/trans-expr.cc  | 12 ++++++------
 gcc/fortran/trans-types.cc |  2 +-
 3 files changed, 12 insertions(+), 12 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 5d16d64..4b570c3 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -7378,13 +7378,13 @@ done:
   /* Set string length for len=:, only.  */
   if (sym->ts.type == BT_CHARACTER && !sym->ts.u.cl->length)
     {
-      tmp = sym->ts.u.cl->backend_decl;
+      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
+      tmp = fold_convert (TREE_TYPE (tmp2), sym->ts.u.cl->backend_decl);
       if (sym->ts.kind != 1)
 	tmp = fold_build2_loc (input_location, MULT_EXPR,
-			       gfc_array_index_type,
-			       sym->ts.u.cl->backend_decl, tmp);
-      tmp2 = gfc_get_cfi_desc_elem_len (cfi);
-      gfc_add_modify (&block, tmp2, fold_convert (TREE_TYPE (tmp2), tmp));
+			       TREE_TYPE (tmp2), tmp,
+			       build_int_cst (TREE_TYPE (tmp2), sym->ts.kind));
+      gfc_add_modify (&block, tmp2, tmp);
     }
 
   if (!sym->attr.dimension)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 1551a2e..e7b9211 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10374,15 +10374,15 @@ gfc_conv_string_parameter (gfc_se * se)
        || TREE_CODE (TREE_TYPE (se->expr)) == INTEGER_TYPE)
       && TYPE_STRING_FLAG (TREE_TYPE (se->expr)))
     {
+      type = TREE_TYPE (se->expr);
       if (TREE_CODE (se->expr) != INDIRECT_REF)
-	{
-	  type = TREE_TYPE (se->expr);
-          se->expr = gfc_build_addr_expr (build_pointer_type (type), se->expr);
-	}
+	se->expr = gfc_build_addr_expr (build_pointer_type (type), se->expr);
       else
 	{
-	  type = gfc_get_character_type_len (gfc_default_character_kind,
-					     se->string_length);
+	  if (TREE_CODE (type) == ARRAY_TYPE)
+	    type = TREE_TYPE (type);
+	  type = gfc_get_character_type_len_for_eltype (type,
+							se->string_length);
 	  type = build_pointer_type (type);
 	  se->expr = gfc_build_addr_expr (type, se->expr);
 	}
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index c062a5b..fdce56d 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -2314,7 +2314,7 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c)
 	      && sym->ns->proc_name->attr.is_bind_c)
 	  || (sym->ts.deferred && (!sym->ts.u.cl
 				   || !sym->ts.u.cl->backend_decl))))
-    type = gfc_character1_type_node;
+    type = gfc_get_char_type (sym->ts.kind);
   else
     type = gfc_typenode_for_spec (&sym->ts, sym->attr.codimension);
 
-- 
cgit v1.1