Commit f208c5cc by Jerry DeLisle

re PR fortran/82007 (DTIO write format stored in a string leads to severe errors)

2018-01-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

        PR fortran/82007
        * resolve.c (resolve_transfer): Delete code looking for 'DT'
        format specifiers in format strings. Set formatted to true if a
        format string or format label is present.
        * trans-io.c (get_dtio_proc): Likewise. (transfer_expr): Fix
        whitespace.

From-SVN: r256649
parent f36180f4
2018-01-13 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/82007
* resolve.c (resolve_transfer): Delete code looking for 'DT'
format specifiers in format strings. Set formatted to true if a
format string or format label is present.
* trans-io.c (get_dtio_proc): Likewise. (transfer_expr): Fix
whitespace.
2018-01-13 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/83744
......
......@@ -9198,19 +9198,9 @@ resolve_transfer (gfc_code *code)
else
derived = ts->u.derived->components->ts.u.derived;
if (dt->format_expr)
{
char *fmt;
fmt = gfc_widechar_to_char (dt->format_expr->value.character.string,
-1);
if (strtok (fmt, "DT") != NULL)
formatted = true;
}
else if (dt->format_label == &format_asterisk)
{
/* List directed io must call the formatted DTIO procedure. */
formatted = true;
}
/* Determine when to use the formatted DTIO procedure. */
if (dt && (dt->format_expr || dt->format_label))
formatted = true;
write = dt->dt_io_kind->value.iokind == M_WRITE
|| dt->dt_io_kind->value.iokind == M_PRINT;
......
......@@ -2227,25 +2227,9 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code, gfc_symbol **dtio_sub)
bool formatted = false;
gfc_dt *dt = code->ext.dt;
if (dt)
{
char *fmt = NULL;
if (dt->format_label == &format_asterisk)
{
/* List directed io must call the formatted DTIO procedure. */
formatted = true;
}
else if (dt->format_expr)
fmt = gfc_widechar_to_char (dt->format_expr->value.character.string,
-1);
else if (dt->format_label)
fmt = gfc_widechar_to_char (dt->format_label->format->value.character.string,
-1);
if (fmt && strtok (fmt, "DT") != NULL)
formatted = true;
}
/* Determine when to use the formatted DTIO procedure. */
if (dt && (dt->format_expr || dt->format_label))
formatted = true;
if (ts->type == BT_CLASS)
derived = ts->u.derived->components->ts.u.derived;
......@@ -2455,8 +2439,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
{
/* Recurse into the elements of the derived type. */
expr = gfc_evaluate_now (addr_expr, &se->pre);
expr = build_fold_indirect_ref_loc (input_location,
expr);
expr = build_fold_indirect_ref_loc (input_location, expr);
/* Make sure that the derived type has been built. An external
function, if only referenced in an io statement, requires this
......
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