PR fortran/21875 Internal Unit Array I/O, NIST

2005-09-14  Jerry DeLisle  <jvdelisle@verizon.net

	PR fortran/21875 Internal Unit Array I/O, NIST
	* libgfortran.h: Add run time error code for array stride.
	* runtime/error.c (translate_error): Add error message for
	array stride.
	* io/io.h: Add array descriptor pointer to IOPARM structure.
	Add prtotypes for two new functions.
	* io/transfer.c (data_transfer_init): Removed initialization and
	moved to unit.c (get_unit)
	* io/transfer.c (next_record_r): Include internal unit read
	functionality.
	* io/transfer.c (next_record_w): Include internal unit write
	functionality, including padding of character array records.
	* io/unit.c (get_array_unit_len): New function to return the number
	of records in the character array 'file' from the array descriptor.
	* io/unit.c (get_unit): Gathered initialization code from
	init_data_transfer for internal units and added initialization of
	character array unit.
	* io/unit.c (is_array_io): New function to determine if internal unit
	is an array.
	* io/unix.c (mem_alloc_w_at): Add error checks for bad record length
	and end of file.

From-SVN: r104276

1 files changed, 10 insertions, 1 deletions

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index ca96c22..e402f44 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -38,6 +38,7 @@ Boston, MA 02110-1301, USA.  */
 #include <stdio.h>
 #include <sys/stat.h>
 #include <fcntl.h>
+#include <assert.h>
 
 #ifdef HAVE_SYS_MMAN_H
 #include <sys/mman.h>
@@ -618,14 +619,22 @@ mem_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
 {
   gfc_offset m;
 
+  assert (*len >= 0);  /* Negative values not allowed. */
+  
   if (where == -1)
     where = s->logical_offset;
 
   m = where + *len;
 
-  if (where < s->buffer_offset || m > s->buffer_offset + s->active)
+  if (where < s->buffer_offset)
     return NULL;
 
+  if (m > s->file_length)
+    {
+      generate_error (ERROR_END, NULL);
+      return NULL;
+    }
+
   s->logical_offset = m;
 
   return s->buffer + (where - s->buffer_offset);