OSDN Git Service

2005-09-14 Jerry DeLisle <jvdelisle@verizon.net
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 14 Sep 2005 20:18:19 +0000 (20:18 +0000)
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Wed, 14 Sep 2005 20:18:19 +0000 (20:18 +0000)
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

libgfortran/ChangeLog
libgfortran/io/io.h
libgfortran/io/transfer.c
libgfortran/io/unit.c
libgfortran/io/unix.c
libgfortran/libgfortran.h
libgfortran/runtime/error.c

index e025ebc..bd2b872 100644 (file)
@@ -1,3 +1,27 @@
+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.
+
 2005-09-13  Richard Sandiford  <richard@codesourcery.com>
 
        PR target/19269
index fc8b887..4f5f88a 100644 (file)
@@ -251,6 +251,7 @@ typedef struct
   CHARACTER (advance);
   CHARACTER (name);
   CHARACTER (internal_unit);
+  gfc_array_char *internal_unit_desc;
   CHARACTER (sequential);
   CHARACTER (direct);
   CHARACTER (formatted);
@@ -525,6 +526,12 @@ internal_proto(close_unit);
 extern int is_internal_unit (void);
 internal_proto(is_internal_unit);
 
+extern int is_array_io (void);
+internal_proto(is_array_io);
+
+extern gfc_offset get_array_unit_len (gfc_array_char *);
+internal_proto(get_array_unit_len);
+
 extern gfc_unit *find_unit (int);
 internal_proto(find_unit);
 
index cb06a79..a279f92 100644 (file)
@@ -292,14 +292,14 @@ void *
 write_block (int length)
 {
   char *dest;
-
-  if (!is_internal_unit() && current_unit->bytes_left < length)
+  
+  if (current_unit->bytes_left < length)
     {
       generate_error (ERROR_EOR, NULL);
       return NULL;
     }
 
-  current_unit->bytes_left -= length;
+  current_unit->bytes_left -= (gfc_offset)length;
   dest = salloc_w (current_unit->s, &length);
 
   if (ioparm.size != NULL)
@@ -1021,15 +1021,6 @@ data_transfer_init (int read_flag)
   if (current_unit == NULL)
     return;
 
-  if (is_internal_unit())
-    {
-      current_unit->recl = file_length(current_unit->s);
-      if (g.mode==WRITING)
-        empty_internal_buffer (current_unit->s);
-      else
-        current_unit->bytes_left = current_unit->recl; 
-    }
-
   /* Check the action.  */
 
   if (read_flag && current_unit->flags.action == ACTION_WRITE)
@@ -1267,7 +1258,7 @@ data_transfer_init (int read_flag)
 static void
 next_record_r (void)
 {
-  int rlength, length;
+  int rlength, length, bytes_left;
   gfc_offset new;
   char *p;
 
@@ -1321,16 +1312,18 @@ next_record_r (void)
          break;
        }
 
-      do
+      if (is_internal_unit())
+       {
+         bytes_left = (int) current_unit->bytes_left;
+         p = salloc_r (current_unit->s, &bytes_left);
+         if (p != NULL)
+           current_unit->bytes_left = current_unit->recl;
+         break;
+       }
+      else do
        {
          p = salloc_r (current_unit->s, &length);
 
-         /* In case of internal file, there may not be any '\n'.  */
-         if (is_internal_unit() && p == NULL)
-           {
-              break;
-           }
-
          if (p == NULL)
            {
              generate_error (ERROR_OS, NULL);
@@ -1359,7 +1352,7 @@ static void
 next_record_w (void)
 {
   gfc_offset c, m;
-  int length;
+  int length, bytes_left;
   char *p;
 
   /* Zero counters for X- and T-editing.  */
@@ -1422,15 +1415,36 @@ next_record_w (void)
       break;
 
     case FORMATTED_SEQUENTIAL:
+
+      if (current_unit->bytes_left == 0)
+       break;
+       
+      if (is_internal_unit())
+       {
+         if (is_array_io())
+           {
+             bytes_left = (int) current_unit->bytes_left;
+             p = salloc_w (current_unit->s, &bytes_left);
+             if (p != NULL)
+               {
+                 memset(p, ' ', bytes_left);
+                 current_unit->bytes_left = current_unit->recl;
+               }
+           }
+         else
+           {
+             length = 1;
+             p = salloc_w (current_unit->s, &length);
+           }
+       }
+      else
+       {
 #ifdef HAVE_CRLF
-      length = 2;
+         length = 2;
 #else
-      length = 1;
+         length = 1;
 #endif
-      p = salloc_w (current_unit->s, &length);
-
-      if (!is_internal_unit())
-       {
+         p = salloc_w (current_unit->s, &length);
          if (p)
            {  /* No new line for internal writes.  */
 #ifdef HAVE_CRLF
@@ -1444,9 +1458,6 @@ next_record_w (void)
            goto io_error;
        }
 
-      if (sfree (current_unit->s) == FAILURE)
-       goto io_error;
-
       break;
 
     io_error:
index 9cea354..586e9ed 100644 (file)
@@ -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 */
index ca96c22..e402f44 100644 (file)
@@ -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);
index 4b9e47a..07f0614 100644 (file)
@@ -344,6 +344,7 @@ typedef enum
   ERROR_BAD_US,
   ERROR_READ_VALUE,
   ERROR_READ_OVERFLOW,
+  ERROR_ARRAY_STRIDE,
   ERROR_LAST                   /* Not a real error, the last error # + 1.  */
 }
 error_codes;
index 3c1686d..7c708e3 100644 (file)
@@ -431,6 +431,10 @@ translate_error (int code)
       p = "Numeric overflow on read";
       break;
 
+    case ERROR_ARRAY_STRIDE:
+      p = "Array unit stride must be 1";
+      break;
+
     default:
       p = "Unknown error code";
       break;