This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, libgforran] PR37294 Namelist I/O to array character internal units
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: Fortran List <fortran at gcc dot gnu dot org>, Gcc Patches <gcc-patches at gcc dot gnu dot org>
- Date: Sun, 09 Nov 2008 19:38:00 -0800
- Subject: [patch, libgforran] PR37294 Namelist I/O to array character internal units
The attached patch fixes this bug by using the internal array unit loop
specification to advance to the next record in the array as needed. Fairly
straight forward.
Regression tested on x86-64-gnu-linux.
OK to commit?
Jerry
2008-11-09 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.
Index: write.c
===================================================================
--- write.c (revision 141721)
+++ write.c (working copy)
@@ -1146,6 +1146,35 @@ namelist_write_newline (st_parameter_dt
#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;
}
! { dg-do run }
! PR37294 Namelist I/O to array character internal units.
! Test case from adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
character(30) :: line(3)
namelist /stuff/ n
n = 123
line = ""
write(line,nml=stuff)
if (line(1) .ne. "&STUFF") call abort
if (line(2) .ne. " N= 123,") call abort
if (line(3) .ne. " /") call abort
end