Commit 8a221914 by Jerry DeLisle

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
parent cea93abb
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> 2008-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/36476 PR fortran/36476
......
...@@ -525,7 +525,7 @@ support is reported in the @ref{Fortran 2003 status} section of the ...@@ -525,7 +525,7 @@ support is reported in the @ref{Fortran 2003 status} section of the
documentation. documentation.
The next version of the Fortran standard after Fortran 2003 is currently 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 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 (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 future compatibility is made, as the final standard might differ from the
......
...@@ -121,6 +121,7 @@ enum iocall ...@@ -121,6 +121,7 @@ enum iocall
IOCALL_X_INTEGER, IOCALL_X_INTEGER,
IOCALL_X_LOGICAL, IOCALL_X_LOGICAL,
IOCALL_X_CHARACTER, IOCALL_X_CHARACTER,
IOCALL_X_CHARACTER_WIDE,
IOCALL_X_REAL, IOCALL_X_REAL,
IOCALL_X_COMPLEX, IOCALL_X_COMPLEX,
IOCALL_X_ARRAY, IOCALL_X_ARRAY,
...@@ -327,6 +328,13 @@ gfc_build_io_library_fndecls (void) ...@@ -327,6 +328,13 @@ gfc_build_io_library_fndecls (void)
void_type_node, 3, dt_parm_type, void_type_node, 3, dt_parm_type,
pvoid_type_node, gfc_int4_type_node); 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] = iocall[IOCALL_X_REAL] =
gfc_build_library_function_decl (get_identifier (PREFIX("transfer_real")), gfc_build_library_function_decl (get_identifier (PREFIX("transfer_real")),
void_type_node, 3, dt_parm_type, void_type_node, 3, dt_parm_type,
...@@ -1977,7 +1985,7 @@ transfer_array_component (tree expr, gfc_component * cm) ...@@ -1977,7 +1985,7 @@ transfer_array_component (tree expr, gfc_component * cm)
static void static void
transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) 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; gfc_component *c;
int kind; int kind;
...@@ -2009,6 +2017,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) ...@@ -2009,6 +2017,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
kind = ts->kind; kind = ts->kind;
function = NULL; function = NULL;
arg2 = NULL; arg2 = NULL;
arg3 = NULL;
switch (ts->type) switch (ts->type)
{ {
...@@ -2033,6 +2042,26 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code) ...@@ -2033,6 +2042,26 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
break; break;
case BT_CHARACTER: 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: case BT_HOLLERITH:
if (se->string_length) if (se->string_length)
arg2 = se->string_length; arg2 = se->string_length;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment