OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
2017-08-21  Jerry DeLisle  <jvdelisle@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.

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

From-SVN: r251254
This commit is contained in:
Jerry DeLisle 2017-08-22 01:02:15 +00:00
parent 4f1aa9fbd4
commit bef016bff7
4 changed files with 33 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2017-08-21 Jerry DeLisle <jvdelisle@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.
2017-08-16 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/81116

26
gcc/fortran/trans-io.c
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)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2017-08-21 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/81296
* gfortran.dg/dtio_12.f90: Update test.
2017-08-21 Nathan Sidwell <nathan@acm.org>
* g++.dg/template/pr81899.C: Fix c++03.

6
gcc/testsuite/gfortran.dg/dtio_12.f90
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