[Patch, libgfortran] PR29936 Missed constraint on RECL=specifier in unformatted sequential WRITE

[Jerry DeLisle <jvdelisle at verizon dot net>]

Hi,

The attached patch adds a flag to the units flags structure to identify if a 
RECL= was specified in the OPEN statement.  This flag is then initialized in 
new_unit and is used in us_write to not set the current_unit->recl to max_record.

I will commit to trunk as simple and obvious along with a suitable test case.

I will commit to 4.2 this weekend.  I want to think about whether this will 
break compatibility on 4.1 before back porting there.

Regression tested on x86-64.

Cheers,

Jerry

2006-11-22  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	* io/io.h (unit_flags): Add new flag has_recl.
	* io.open.c (new_unit): Set flag if RECL= was specified.
	* io/transfer.c (us_write): If flag set, leave recl as initialized by
	new_unit.

Index: io/open.c
===================================================================
*** io/open.c	(revision 119086)
--- io/open.c	(working copy)
*************** new_unit (st_parameter_open *opp, gfc_un
*** 406,414 ****
    /* Unspecified recl ends up with a processor dependent value.  */
  
    if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
!     u->recl = opp->recl_in;
    else
      {
        switch (compile_options.record_marker)
  	{
  	case 0:
--- 406,418 ----
    /* Unspecified recl ends up with a processor dependent value.  */
  
    if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN))
!     {
!       u->flags.has_recl = 1;
!       u->recl = opp->recl_in;
!     }
    else
      {
+       u->flags.has_recl = 0;
        switch (compile_options.record_marker)
  	{
  	case 0:
Index: io/io.h
===================================================================
*** io/io.h	(revision 119086)
--- io/io.h	(working copy)
*************** typedef struct
*** 470,475 ****
--- 470,476 ----
    unit_status status;
    unit_pad pad;
    unit_convert convert;
+   int has_recl;
  }
  unit_flags;
  
Index: io/transfer.c
===================================================================
*** io/transfer.c	(revision 119086)
--- io/transfer.c	(working copy)
*************** us_write (st_parameter_dt *dtp)
*** 1459,1468 ****
    if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0)
      generate_error (&dtp->common, ERROR_OS, NULL);
  
!   /* For sequential unformatted, we write until we have more bytes
!      than can fit in the record markers. If disk space runs out first,
!      it will error on the write.  */
!   dtp->u.p.current_unit->recl = max_offset;
  
    dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
  }
--- 1459,1469 ----
    if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0)
      generate_error (&dtp->common, ERROR_OS, NULL);
  
!   /* For sequential unformatted, if RECL= was not specified in the OPEN
!      we write until we have more bytes than can fit in the record markers.
!      If disk space runs out first, it will error on the write.   */
!   if (dtp->u.p.current_unit->flags.has_recl == 0)
!     dtp->u.p.current_unit->recl = max_offset;
  
    dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
  }