re PR fortran/35699 (run-time abort writing zero sized section to direct access file)

2008-03-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/35699
	* io/transfer.c (write_buf):  Don't pad the record, just return if the
	data is NULL.  (next_record_w): If there are bytes left in the record
	for unformatted direct I/O, pad out the record with zero bytes.

From-SVN: r133699

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 57ec570681c17098a89abb99020c451845a142a9..9e10c90b7e42c3db6ec50245bbe8ab0b59440df5 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2008-03-28  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/35699
+       * io/transfer.c (write_buf):  Don't pad the record, just return if the
+       data is NULL.  (next_record_w): If there are bytes left in the record
+       for unformatted direct I/O, pad out the record with zero bytes.
+
 2008-03-28  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/35721

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 5ccc95823a880e0012492df6f3757e1a7d3a5658..dc80fc33f9e04143f6eb5379e981391e7ad342b3 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -639,12 +639,7 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes)
        }
 
       if (buf == NULL && nbytes == 0)
-       {
-          char *p;
-          p = write_block (dtp, dtp->u.p.current_unit->recl);
-          memset (p, 0, dtp->u.p.current_unit->recl);
-          return SUCCESS;
-       }
+       return SUCCESS;
 
       if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0)
        {
@@ -2493,6 +2488,13 @@ next_record_w (st_parameter_dt *dtp, int done)
       break;
 
     case UNFORMATTED_DIRECT:
+      if (dtp->u.p.current_unit->bytes_left > 0)
+       {
+         length = (int) dtp->u.p.current_unit->bytes_left;
+         p = salloc_w (dtp->u.p.current_unit->s, &length);
+         memset (p, 0, length);
+       }
+
       if (sfree (dtp->u.p.current_unit->s) == FAILURE)
        goto io_error;
       break;