diff options
| -rw-r--r-- | libgfortran/ChangeLog | 24 | ||||
| -rw-r--r-- | libgfortran/io/io.h | 7 | ||||
| -rw-r--r-- | libgfortran/io/transfer.c | 71 | ||||
| -rw-r--r-- | libgfortran/io/unit.c | 47 | ||||
| -rw-r--r-- | libgfortran/io/unix.c | 11 | ||||
| -rw-r--r-- | libgfortran/libgfortran.h | 1 | ||||
| -rw-r--r-- | libgfortran/runtime/error.c | 4 |
7 files changed, 132 insertions, 33 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index e025ebc51db..bd2b872c857 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -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 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index fc8b8873d8a..4f5f88a58cd 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -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); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index cb06a79fba5..a279f92151e 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -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: 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 */ diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index ca96c229b48..e402f4432c9 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); diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 4b9e47a126a..07f0614a0b3 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -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; diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 3c1686d947d..7c708e3db4e 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -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; |