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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@104276 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 45 insertions, 2 deletions

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 9cea354e736..586e9edf3d3 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -244,6 +244,32 @@ find_unit (int n)
   return p;
 }
 
+
+/* get_array_unit_len()-- return the number of records in the array. */
+
+gfc_offset
+get_array_unit_len (gfc_array_char *desc)
+{
+  gfc_offset record_count;
+  int i, rank, stride;
+  rank = GFC_DESCRIPTOR_RANK(desc);
+  record_count = stride = 1;
+  for (i=0;i<rank;++i)
+    {
+      /* Check that array is contiguous */
+      
+      if (desc->dim[i].stride != stride)
+	{
+	  generate_error (ERROR_ARRAY_STRIDE, NULL);
+	  return NULL;
+	}
+      stride *= desc->dim[i].ubound;
+      record_count *= desc->dim[i].ubound;
+    }
+  return record_count;
+}
+
+ 
 /* get_unit()-- Returns the unit structure associated with the integer
  * unit or the internal file. */
 
@@ -252,8 +278,18 @@ get_unit (int read_flag __attribute__ ((unused)))
 {
   if (ioparm.internal_unit != NULL)
     {
+      internal_unit.recl = ioparm.internal_unit_len;
+      if (is_array_io()) ioparm.internal_unit_len *=
+			   get_array_unit_len(ioparm.internal_unit_desc);
       internal_unit.s =
 	open_internal (ioparm.internal_unit, ioparm.internal_unit_len);
+      internal_unit.bytes_left = internal_unit.recl;
+      internal_unit.last_record=0;
+      internal_unit.maxrec=0;
+      internal_unit.current_record=0;
+
+      if (g.mode==WRITING && !is_array_io())
+        empty_internal_buffer (internal_unit.s);
 
       /* Set flags for the internal unit */
 
@@ -271,8 +307,7 @@ get_unit (int read_flag __attribute__ ((unused)))
 }
 
 
-/* is_internal_unit()-- Determine if the current unit is internal or
- * not */
+/* is_internal_unit()-- Determine if the current unit is internal or not */
 
 int
 is_internal_unit (void)
@@ -281,6 +316,14 @@ is_internal_unit (void)
 }
 
 
+/* is_array_io ()-- Determine if the I/O is to/from an array */
+
+int
+is_array_io (void)
+{
+  return (ioparm.internal_unit_desc != NULL);
+}
+
 
 /*************************/
 /* Initialize everything */