diff options
| author | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2008-11-15 19:25:35 +0000 |
|---|---|---|
| committer | Jerry DeLisle <jvdelisle@gcc.gnu.org> | 2008-11-15 19:25:35 +0000 |
| commit | 94bc6c1e77dcb12b6b140a0a6431cd7c4e053a3f (patch) | |
| tree | d03fb11bf56dd56527d1a585fd6d12ef77833bc8 /libgfortran | |
| parent | 4d45d495663618e45f0a0baa481b74ee7a87a597 (diff) | |
| download | gcc-94bc6c1e77dcb12b6b140a0a6431cd7c4e053a3f.tar.gz | |
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
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 7 | ||||
| -rw-r--r-- | libgfortran/io/write.c | 31 |
2 files changed, 37 insertions, 1 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2903760cb8c..42aca0ce1e3 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -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 diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index 12ff2953c62..32c58471bb8 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -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; } |