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 4a6b07a76920a5a2991e66da34e94462c7019525..08c93d50b83c547ef6c3822e1a555e93a3abd752 100644 (file)
--- 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 c47f22fcfa045cb9bbf1a9be20ab5f4a24b1a1f5..086aab7b50b66854b572637a1cc3699cfa05cc76 100644 (file)
--- 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 2f35002a5ac06904bb6e20eed99219b0067f2825..f210169abe028c9d2c9837b527632c19b7f0f85f 100644 (file)
--- 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;