backport: re PR fortran/81296 (derived type I/o problem)

2017-08-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	Backport from trunk
	PR fortran/81296
	* trans-io.c (get_dtio_proc): Add check for format label and set
	formatted flag accordingly. Reorganize the code a little.

	* gfortran.dg/dtio_12.f90: Update test.

From-SVN: r251301
This commit is contained in:
Jerry DeLisle 2017-08-23 00:41:10 +00:00
parent f4abc808dc
commit d684a9bb4b
4 changed files with 35 additions and 10 deletions

View File

@ -1,3 +1,10 @@
2017-08-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk
PR fortran/81296
* trans-io.c (get_dtio_proc): Add check for format label and set
formatted flag accordingly. Reorganize the code a little.
2017-08-18 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk

View File

@ -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)

View File

@ -1,3 +1,9 @@
2017-08-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
Backport from trunk
PR fortran/81296
* gfortran.dg/dtio_12.f90: Update test.
2017-08-22 Peter Bergner <bergner@vnet.ibm.com>
Backport from mainline

View File

@ -67,6 +67,12 @@ end module
if (trim (msg) .ne. "42") call abort
rewind (10)
write (10,"(DT)") child (77) ! The original testcase
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