This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch, libgfortran] Fix PR20257 End of record occurs when writing large arrays


:ADDPATCH fortran:

This patch fixes the PR. When bytes_left is less then the requested read or write size, a check for preconnected units (stdin, stdout, stderr) is made before generating an error and the bytes_left is reset to the dafault record length. In such a case the error is skipped and the I/O allowed to proceed normally.

This bypassing of the error is only allowed if the units assigned record length is equal to the default which is very large. So the bypass will only occur every blue moon. If the user has set the record length deliberately to something other than the default, then it is assumed they mean it and the error will not be skipped.

You will notice an absurd unit number being assigned to internal units. It turns out that the stderr unit number is zero. To avoid mistaking an internal unit as preconnected I set it to 135790. This also eliminates a case of accessing an uninitialized value pointed out by valgrind.

While at it, I also fixed a few cases of flushing with internal units and cleaned up free_mem use for internal units, consolidating and cleaning up the code. This eliminates several errors noted by valgrind.

I tested the error bypass by artificially setting the default record length to something smaller. I had to do this to test because I don't have enough memory in my machine here to set such a large array without getting into disk swapping.

The final patch has been regression tested on i686, NIST tested, many I/O tested and checked with valgrind on a few cases that valgrind noted had problems. All looks solid on this end. (I even got a little progress on tonto-1.0 with it)

OK for trunk and then later 4.1.1?

A test case is somewhat impractical for this feature. (open to suggestions) Could someone who likes to do things with very large arrays/files test this?

Best regards,

Jerry

2006-04-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libgfortran/20257
	* io/io.h: Add prototypes for get_internal_unit and free_internal_unit.
	* io/unit.c (get_internal_unit): Initialize unit number, not zero.
	(free_internal_unit): New function to consolidate freeing memory.
	(get_unit): Initialize internal_unit_desc to NULL when unit is
	external.
	* io/unix.c (mem_close): Check for not NULL before freeing memory.
	* io/transfer.c (read_block): Reset bytes_left and skip error if unit
	is preconnected if default record length is reached.
	(read_block_direct): Ditto.
	(write_block): Ditto.
	(write_buf): Ditto.
	(data_transfer_init): Only flush if not internal unit.
	(finalize_transfer): Ditto and delete code to free memory used by
	internal units.
	(st_read_done): Use new function - free_internal_unit.
	(st_write_done): Use new function - free_internal unit.
Index: io/io.h
===================================================================
*** io/io.h	(revision 113060)
--- io/io.h	(working copy)
*************** internal_proto(unit_lock);
*** 702,707 ****
--- 702,713 ----
  extern int close_unit (gfc_unit *);
  internal_proto(close_unit);
  
+ extern gfc_unit *get_internal_unit (st_parameter_dt *);
+ internal_proto(get_internal_unit);
+ 
+ extern void free_internal_unit (st_parameter_dt *);
+ internal_proto(free_internal_unit);
+ 
  extern int is_internal_unit (st_parameter_dt *);
  internal_proto(is_internal_unit);
  
Index: io/unit.c
===================================================================
*** io/unit.c	(revision 113060)
--- io/unit.c	(working copy)
*************** get_internal_unit (st_parameter_dt *dtp)
*** 378,383 ****
--- 378,387 ----
    memset (iunit, '\0', sizeof (gfc_unit));
  
    iunit->recl = dtp->internal_unit_len;
+   
+   /* For internal units we set the unit number to something unlikely
+      to be used.  Otherwise internal units can be mistaken for stderr.  */
+   iunit->unit_number = 135790;
  
    /* Set up the looping specification from the array descriptor, if any.  */
  
*************** get_internal_unit (st_parameter_dt *dtp)
*** 424,429 ****
--- 428,450 ----
  }
  
  
+ /* free_internal_unit()-- Free memory allocated for internal units if any.  */
+ void
+ free_internal_unit (st_parameter_dt *dtp)
+ {
+   if (!is_internal_unit (dtp))
+     return;
+ 
+   if (dtp->u.p.current_unit->ls != NULL)
+       free_mem (dtp->u.p.current_unit->ls);
+   
+   sclose (dtp->u.p.current_unit->s);
+ 
+   if (dtp->u.p.current_unit != NULL)
+     free_mem (dtp->u.p.current_unit);
+ }
+ 
+ 
  /* get_unit()-- Returns the unit structure associated with the integer
   * unit or the internal file. */
  
*************** get_unit (st_parameter_dt *dtp, int do_c
*** 437,442 ****
--- 458,464 ----
    /* Has to be an external unit */
  
    dtp->u.p.unit_is_internal = 0;
+   dtp->internal_unit_desc = NULL;
  
    return get_external_unit (dtp->common.unit, do_create);
  }
Index: io/unix.c
===================================================================
*** io/unix.c	(revision 113060)
--- io/unix.c	(working copy)
*************** mem_truncate (unix_stream * s __attribut
*** 928,934 ****
  static try
  mem_close (unix_stream * s)
  {
!   free_mem (s);
  
    return SUCCESS;
  }
--- 928,935 ----
  static try
  mem_close (unix_stream * s)
  {
!   if (s != NULL)
!     free_mem (s);
  
    return SUCCESS;
  }
Index: io/transfer.c
===================================================================
*** io/transfer.c	(revision 113060)
--- io/transfer.c	(working copy)
*************** read_block (st_parameter_dt *dtp, int *l
*** 257,267 ****
  
    if (dtp->u.p.current_unit->bytes_left < *length)
      {
!       if (dtp->u.p.current_unit->flags.pad == PAD_NO)
  	{
! 	  generate_error (&dtp->common, ERROR_EOR, NULL);
! 	  /* Not enough data left.  */
! 	  return NULL;
  	}
  
        *length = dtp->u.p.current_unit->bytes_left;
--- 257,275 ----
  
    if (dtp->u.p.current_unit->bytes_left < *length)
      {
!       /* For preconnected units with default record length, set bytes left
! 	 to unit record length and proceed, otherwise error.  */
!       if (dtp->u.p.current_unit->unit_number == options.stdin_unit
! 	  && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!         dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
!       else
  	{
! 	  if (dtp->u.p.current_unit->flags.pad == PAD_NO)
! 	    {
! 	      /* Not enough data left.  */
! 	      generate_error (&dtp->common, ERROR_EOR, NULL);
! 	      return NULL;
! 	    }
  	}
  
        *length = dtp->u.p.current_unit->bytes_left;
*************** read_block_direct (st_parameter_dt *dtp,
*** 305,315 ****
  
    if (dtp->u.p.current_unit->bytes_left < *nbytes)
      {
!       if (dtp->u.p.current_unit->flags.pad == PAD_NO)
  	{
! 	  /* Not enough data left.  */
! 	  generate_error (&dtp->common, ERROR_EOR, NULL);
! 	  return;
  	}
  
        *nbytes = dtp->u.p.current_unit->bytes_left;
--- 313,331 ----
  
    if (dtp->u.p.current_unit->bytes_left < *nbytes)
      {
!       /* For preconnected units with default record length, set bytes left
! 	 to unit record length and proceed, otherwise error.  */
!       if (dtp->u.p.current_unit->unit_number == options.stdin_unit
! 	  && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!         dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
!       else
  	{
! 	  if (dtp->u.p.current_unit->flags.pad == PAD_NO)
! 	    {
! 	      /* Not enough data left.  */
! 	      generate_error (&dtp->common, ERROR_EOR, NULL);
! 	      return;
! 	    }
  	}
  
        *nbytes = dtp->u.p.current_unit->bytes_left;
*************** void *
*** 358,368 ****
  write_block (st_parameter_dt *dtp, int length)
  {
    char *dest;
!   
    if (dtp->u.p.current_unit->bytes_left < length)
      {
!       generate_error (&dtp->common, ERROR_EOR, NULL);
!       return NULL;
      }
  
    dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
--- 374,393 ----
  write_block (st_parameter_dt *dtp, int length)
  {
    char *dest;
! 
    if (dtp->u.p.current_unit->bytes_left < length)
      {
!       /* For preconnected units with default record length, set bytes left
! 	 to unit record length and proceed, otherwise error.  */
!       if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
! 	  || dtp->u.p.current_unit->unit_number == options.stderr_unit)
! 	  && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!         dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
!       else
! 	{
! 	  generate_error (&dtp->common, ERROR_EOR, NULL);
! 	  return NULL;
! 	}
      }
  
    dtp->u.p.current_unit->bytes_left -= (gfc_offset) length;
*************** write_buf (st_parameter_dt *dtp, void *b
*** 388,398 ****
  {
    if (dtp->u.p.current_unit->bytes_left < nbytes)
      {
!       if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
! 	generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
        else
! 	generate_error (&dtp->common, ERROR_EOR, NULL);
!       return FAILURE;
      }
  
    dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
--- 413,432 ----
  {
    if (dtp->u.p.current_unit->bytes_left < nbytes)
      {
!       /* For preconnected units with default record length, set bytes left
! 	 to unit record length and proceed, otherwise error.  */
!       if ((dtp->u.p.current_unit->unit_number == options.stdout_unit
! 	  || dtp->u.p.current_unit->unit_number == options.stderr_unit)
! 	  && dtp->u.p.current_unit->recl == DEFAULT_RECL)
!         dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
        else
! 	{
! 	  if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
! 	    generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL);
! 	  else
! 	    generate_error (&dtp->common, ERROR_EOR, NULL);
! 	  return FAILURE;
! 	}
      }
  
    dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes;
*************** data_transfer_init (st_parameter_dt *dtp
*** 1592,1598 ****
  
        /* Check to see if we might be reading what we wrote before  */
  
!       if (dtp->u.p.mode == READING && dtp->u.p.current_unit->mode  == WRITING)
  	 flush(dtp->u.p.current_unit->s);
  
        /* Check whether the record exists to be read.  Only
--- 1626,1634 ----
  
        /* Check to see if we might be reading what we wrote before  */
  
!       if (dtp->u.p.mode == READING
! 	  && dtp->u.p.current_unit->mode == WRITING
! 	  && !is_internal_unit (dtp))
  	 flush(dtp->u.p.current_unit->s);
  
        /* Check whether the record exists to be read.  Only
*************** finalize_transfer (st_parameter_dt *dtp)
*** 2186,2192 ****
  	{
  	  /* Most systems buffer lines, so force the partial record
  	     to be written out.  */
! 	  flush (dtp->u.p.current_unit->s);
  	  dtp->u.p.seen_dollar = 0;
  	  return;
  	}
--- 2222,2229 ----
  	{
  	  /* Most systems buffer lines, so force the partial record
  	     to be written out.  */
! 	  if (!is_internal_unit (dtp))
! 	    flush (dtp->u.p.current_unit->s);
  	  dtp->u.p.seen_dollar = 0;
  	  return;
  	}
*************** finalize_transfer (st_parameter_dt *dtp)
*** 2195,2210 ****
      }
  
    sfree (dtp->u.p.current_unit->s);
- 
-   if (is_internal_unit (dtp))
-     {
-       if (is_array_io (dtp) && dtp->u.p.current_unit->ls != NULL)
- 	free_mem (dtp->u.p.current_unit->ls);
-       sclose (dtp->u.p.current_unit->s);
-     }
  }
  
- 
  /* Transfer function for IOLENGTH. It doesn't actually do any
     data transfer, it just updates the length counter.  */
  
--- 2232,2239 ----
*************** st_read_done (st_parameter_dt *dtp)
*** 2318,2325 ****
      free_mem (dtp->u.p.scratch);
    if (dtp->u.p.current_unit != NULL)
      unlock_unit (dtp->u.p.current_unit);
!   if (is_internal_unit (dtp) && dtp->u.p.current_unit != NULL)
!     free_mem (dtp->u.p.current_unit);
    library_end ();
  }
  
--- 2347,2355 ----
      free_mem (dtp->u.p.scratch);
    if (dtp->u.p.current_unit != NULL)
      unlock_unit (dtp->u.p.current_unit);
! 
!   free_internal_unit (dtp);
!   
    library_end ();
  }
  
*************** st_write_done (st_parameter_dt *dtp)
*** 2372,2379 ****
      free_mem (dtp->u.p.scratch);
    if (dtp->u.p.current_unit != NULL)
      unlock_unit (dtp->u.p.current_unit);
!   if (is_internal_unit (dtp) && dtp->u.p.current_unit != NULL)
!     free_mem (dtp->u.p.current_unit);
    library_end ();
  }
  
--- 2402,2410 ----
      free_mem (dtp->u.p.scratch);
    if (dtp->u.p.current_unit != NULL)
      unlock_unit (dtp->u.p.current_unit);
!   
!   free_internal_unit (dtp);
! 
    library_end ();
  }
  

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]