OSDN Git Service

2008-06-13 Jerry DeLisle <jvdelisle@gcc.gnu.org>
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 13 Jun 2008 20:30:48 +0000 (20:30 +0000)
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Fri, 13 Jun 2008 20:30:48 +0000 (20:30 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@136764 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/fortran/ChangeLog
gcc/fortran/gfortran.texi
gcc/fortran/trans-io.c

index 4a6b07a..08c93d5 100644 (file)
@@ -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
index c47f22f..086aab7 100644 (file)
@@ -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
index 2f35002..f210169 100644 (file)
@@ -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;