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

re PR libfortran/37294 (Namelist I/O to array character internal units) 

2008-11-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/37294
	* io/write.c (namelist_write_newline): Use array loop specification to
	advance to next internal array unit record. (namelist_write): Adjust to
	accomodate the internal array unit behavior.

From-SVN: r141892
This commit is contained in:
Jerry DeLisle 2008-11-15 19:25:35 +00:00
parent 4d45d49566
commit 94bc6c1e77
2 changed files with 37 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
libgfortran/ChangeLog
View File

@ -1,3 +1,10 @@
2008-11-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/37294
* io/write.c (namelist_write_newline): Use array loop specification to
advance to next internal array unit record. (namelist_write): Adjust to
accomodate the internal array unit behavior.
2008-11-01 Dennis Wassel <dennis.wassel@gmail.com>
PR fortran/37159

31
libgfortran/io/write.c
View File

@ -1146,6 +1146,35 @@ namelist_write_newline (st_parameter_dt *dtp)
#else
write_character (dtp, "\n", 1, 1);
#endif
return;
}
if (is_array_io (dtp))
{
gfc_offset record;
int finished, length;
length = (int) dtp->u.p.current_unit->bytes_left;
/* Now that the current record has been padded out,
determine where the next record in the array is. */
record = next_array_record (dtp, dtp->u.p.current_unit->ls,
&finished);
if (finished)
dtp->u.p.current_unit->endfile = AT_ENDFILE;
else
{
/* Now seek to this record */
record = record * dtp->u.p.current_unit->recl;
if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
{
generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
return;
}
dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
}
}
else
write_character (dtp, " ", 1, 1);
@ -1467,8 +1496,8 @@ namelist_write (st_parameter_dt *dtp)
}
}
write_character (dtp, " /", 1, 3);
namelist_write_newline (dtp);
write_character (dtp, " /", 1, 2);
/* Restore the original delimiter. */
dtp->u.p.current_unit->delim_status = tmp_delim;
}