From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Fri, 13 Jun 2008 20:30:48 +0000 (+0000)
Subject: re PR libfortran/35863 ([F2003] Implement ENCODING="UTF-8")
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8a22191467dbfb77381a1d204ad96515bc3022c2;p=gcc.git

re PR libfortran/35863 ([F2003] Implement ENCODING="UTF-8")

2008-06-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/35863
	* trans-io.c (gfc_build_io_library_fndecls): Build declaration for
	transfer_character_wide which includes passing in the character kind to
	support wide character IO. (transfer_expr): If the kind == 4, create the
	argument and build the call.
	* gfortran.texi: Fix typo.

From-SVN: r136764
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4a6b07a7692..08c93d50b83 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2008-06-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR fortran/35863
+	* trans-io.c (gfc_build_io_library_fndecls): Build declaration for
+	transfer_character_wide which includes passing in the character kind to
+	support wide character IO. (transfer_expr): If the kind == 4, create the
+	argument and build the call.
+	* gfortran.texi: Fix typo.
+
 2008-06-13  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/36476
diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index c47f22fcfa0..086aab7b50b 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -525,7 +525,7 @@ support is reported in the @ref{Fortran 2003 status} section of the
 documentation.
 
 The next version of the Fortran standard after Fortran 2003 is currently
-being developped and the GNU Fortran compiler supports some of its new
+being developed and the GNU Fortran compiler supports some of its new
 features. This support is based on the latest draft of the standard
 (available from @url{http://www.nag.co.uk/sc22wg5/}) and no guarantee of
 future compatibility is made, as the final standard might differ from the
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 2f35002a5ac..f210169abe0 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -121,6 +121,7 @@ enum iocall
   IOCALL_X_INTEGER,
   IOCALL_X_LOGICAL,
   IOCALL_X_CHARACTER,
+  IOCALL_X_CHARACTER_WIDE,
   IOCALL_X_REAL,
   IOCALL_X_COMPLEX,
   IOCALL_X_ARRAY,
@@ -327,6 +328,13 @@ gfc_build_io_library_fndecls (void)
 				     void_type_node, 3, dt_parm_type,
 				     pvoid_type_node, gfc_int4_type_node);
 
+  iocall[IOCALL_X_CHARACTER_WIDE] =
+    gfc_build_library_function_decl (get_identifier
+				     (PREFIX("transfer_character_wide")),
+				     void_type_node, 4, dt_parm_type,
+				     pvoid_type_node, gfc_charlen_type_node,
+				     gfc_int4_type_node);
+
   iocall[IOCALL_X_REAL] =
     gfc_build_library_function_decl (get_identifier (PREFIX("transfer_real")),
 				     void_type_node, 3, dt_parm_type,
@@ -1977,7 +1985,7 @@ transfer_array_component (tree expr, gfc_component * cm)
 static void
 transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
 {
-  tree tmp, function, arg2, field, expr;
+  tree tmp, function, arg2, arg3, field, expr;
   gfc_component *c;
   int kind;
 
@@ -2009,6 +2017,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
   kind = ts->kind;
   function = NULL;
   arg2 = NULL;
+  arg3 = NULL;
 
   switch (ts->type)
     {
@@ -2033,6 +2042,26 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
       break;
 
     case BT_CHARACTER:
+      if (kind == 4)
+	{
+	  if (se->string_length)
+	    arg2 = se->string_length;
+	  else
+	    {
+	      tmp = build_fold_indirect_ref (addr_expr);
+	      gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == ARRAY_TYPE);
+	      arg2 = TYPE_MAX_VALUE (TYPE_DOMAIN (TREE_TYPE (tmp)));
+	      arg2 = fold_convert (gfc_charlen_type_node, arg2);
+	    }
+	  arg3 = build_int_cst (NULL_TREE, kind);
+	  function = iocall[IOCALL_X_CHARACTER_WIDE];
+	  tmp = build_fold_addr_expr (dt_parm);
+	  tmp = build_call_expr (function, 4, tmp, addr_expr, arg2, arg3);
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	  gfc_add_block_to_block (&se->pre, &se->post);
+	  return;
+	}
+      /* Fall through. */
     case BT_HOLLERITH:
       if (se->string_length)
 	arg2 = se->string_length;