Hi all,
The attached patch adds a check for the format label containing a "DT" format
descriptor and enables the generation of the correct code. The patch modifies
an existing test case as a future check on this.
Regression tested on x86_64-linux.
OK for trunk and backport to 7?
Regards,
Jerry
2017-08-21 Jerry DeLisle <jvdeli...@gcc.gnu.org>
PR fortran/81296
* trans-io.c (get_dtio_proc): Add check for format label and set
formatted flag accordingly. Reorganize the code a little.
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index c3c56f29..aa974eb3 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -2214,18 +2214,24 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code, gfc_symbol **dtio_sub)
bool formatted = false;
gfc_dt *dt = code->ext.dt;
- if (dt && dt->format_expr)
+ if (dt)
{
- char *fmt;
- fmt = gfc_widechar_to_char (dt->format_expr->value.character.string,
- -1);
- if (strtok (fmt, "DT") != NULL)
+ 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;
- }
- else if (dt && dt->format_label == &format_asterisk)
- {
- /* List directed io must call the formatted DTIO procedure. */
- formatted = true;
+
}
if (ts->type == BT_CLASS)
diff --git a/gcc/testsuite/gfortran.dg/dtio_12.f90 b/gcc/testsuite/gfortran.dg/dtio_12.f90
index 213f7ebb..cf1bfe38 100644
--- a/gcc/testsuite/gfortran.dg/dtio_12.f90
+++ b/gcc/testsuite/gfortran.dg/dtio_12.f90
@@ -70,5 +70,11 @@ end module
rewind (10)
read (10, *) msg
if (trim (msg) .ne. "77") call abort
+ rewind (10)
+ write (10,40) child (77) ! Modified using format label
+40 format(DT)
+ rewind (10)
+ read (10, *) msg
+ if (trim (msg) .ne. "77") call abort
close(10)
end
