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> 2018-01-13 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/83744 PR fortran/83744
......
...@@ -9198,19 +9198,9 @@ resolve_transfer (gfc_code *code) ...@@ -9198,19 +9198,9 @@ resolve_transfer (gfc_code *code)
else else
derived = ts->u.derived->components->ts.u.derived; derived = ts->u.derived->components->ts.u.derived;
if (dt->format_expr) /* Determine when to use the formatted DTIO procedure. */
{ if (dt && (dt->format_expr || dt->format_label))
char *fmt; formatted = true;
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;
}
write = dt->dt_io_kind->value.iokind == M_WRITE write = dt->dt_io_kind->value.iokind == M_WRITE
|| dt->dt_io_kind->value.iokind == M_PRINT; || 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) ...@@ -2227,25 +2227,9 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code, gfc_symbol **dtio_sub)
bool formatted = false; bool formatted = false;
gfc_dt *dt = code->ext.dt; gfc_dt *dt = code->ext.dt;
if (dt) /* Determine when to use the formatted DTIO procedure. */
{ if (dt && (dt->format_expr || dt->format_label))
char *fmt = NULL; formatted = true;
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;
}
if (ts->type == BT_CLASS) if (ts->type == BT_CLASS)
derived = ts->u.derived->components->ts.u.derived; derived = ts->u.derived->components->ts.u.derived;
...@@ -2455,8 +2439,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, ...@@ -2455,8 +2439,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
{ {
/* Recurse into the elements of the derived type. */ /* Recurse into the elements of the derived type. */
expr = gfc_evaluate_now (addr_expr, &se->pre); expr = gfc_evaluate_now (addr_expr, &se->pre);
expr = build_fold_indirect_ref_loc (input_location, expr = build_fold_indirect_ref_loc (input_location, expr);
expr);
/* Make sure that the derived type has been built. An external /* Make sure that the derived type has been built. An external
function, if only referenced in an io statement, requires this 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