diff -uNr gcc-4061.orig/libgfortran/io/transfer.c gcc-4061/libgfortran/io/transfer.c --- gcc-4061.orig/libgfortran/io/transfer.c 2005-05-28 21:35:43.000000000 +0900 +++ gcc-4061/libgfortran/io/transfer.c 2005-06-03 22:49:57.000000000 +0900 @@ -55,6 +55,7 @@ gfc_unit *current_unit; static int sf_seen_eor = 0; +static int eor_condition = 0; char scratch[SCRATCH_SIZE]; static char *line_buffer = NULL; @@ -126,7 +127,13 @@ else p = base = data; - memset(base,'\0',*length); + /* If we have seen an eor previously, return a length of 0. The + caller is responsible for correctly padding the input field. */ + if (sf_seen_eor) + { + *length = 0; + return base; + } current_unit->bytes_left = options.default_recl; readlen = 1; @@ -147,21 +154,24 @@ /* If we have a line without a terminating \n, drop through to EOR below. */ - if (readlen < 1 & n == 0) + if (readlen < 1 && n == 0) { generate_error (ERROR_END, NULL); return NULL; } - if (readlen < 1 || *q == '\n') + if (readlen < 1 || *q == '\n' || *q == '\r') { - /* ??? What is this for? */ - if (current_unit->unit_number == options.stdin_unit) - { - if (n <= 0) - continue; - } /* Unexpected end of line. */ + + /* If we see an EOR during non-advancing I/O, we need to skip + the rest of the I/O statement. Set the corresponding flag. */ + if (advance_status == ADVANCE_NO) + eor_condition = 1; + + /* Without padding, terminate the I/O statement without assigning + the value. With padding, the value still needs to be assigned, + so we can just continue with a short read. */ if (current_unit->flags.pad == PAD_NO) { generate_error (ERROR_EOR, NULL); @@ -180,6 +190,9 @@ } while (n < *length); + if (ioparm.size != NULL) + *ioparm.size += *length; + return base; } @@ -271,6 +284,13 @@ { void *source; int w; + + /* Transfer functions get passed the kind of the entity, so we have + to fix this for COMPLEX data which are twice the size of their + kind. */ + if (type == BT_COMPLEX) + length *= 2; + w = length; source = read_block (&w); @@ -288,9 +308,14 @@ unformatted_write (bt type, void *source, int length) { void *dest; - dest = write_block (length); - if (dest != NULL) - memcpy (dest, source, length); + + /* Correction for kind vs. length as in unformatted_read. */ + if (type == BT_COMPLEX) + length *= 2; + + dest = write_block (length); + if (dest != NULL) + memcpy (dest, source, length); } @@ -350,7 +375,7 @@ for (; length > 0; length--) { c = *p++ = *q++; - if (c == delimiter && c != 'H') + if (c == delimiter && c != 'H' && c != 'h') q++; /* Skip the doubled delimiter. */ } } @@ -398,16 +423,21 @@ if (type == BT_COMPLEX) type = BT_REAL; - /* If reversion has occurred and there is another real data item, - then we have to move to the next record. */ + /* If there's an EOR condition, we simulate finalizing the transfer + by doing nothing. */ + if (eor_condition) + return; - if (g.reversion_flag && n > 0) - { - g.reversion_flag = 0; - next_record (0); - } for (;;) { + /* If reversion has occurred and there is another real data item, + then we have to move to the next record. */ + if (g.reversion_flag && n > 0) + { + g.reversion_flag = 0; + next_record (0); + } + consume_data_flag = 1 ; if (ioparm.library_return != LIBRARY_OK) break; @@ -469,6 +499,10 @@ case FMT_A: if (n == 0) goto need_data; +#if 0 + if (require_type (BT_CHARACTER, type, f)) + return; +#endif if (g.mode == READING) read_a (f, p, len); @@ -731,16 +765,15 @@ return; -/* Come here when we need a data descriptor but don't have one. We - push the current format node back onto the input, then return and - let the user program call us back with the data. */ + /* Come here when we need a data descriptor but don't have one. We + push the current format node back onto the input, then return and + let the user program call us back with the data. */ -need_data: + need_data: unget_format (f); } - /* Data transfer entry points. The type of the data entity is implicit in the subroutine call. This prevents us from having to share a common enum with the compiler. */ @@ -805,11 +838,15 @@ static void us_read (void) { - gfc_offset *p; + char *p; int n; + gfc_offset i; n = sizeof (gfc_offset); - p = (gfc_offset *) salloc_r (current_unit->s, &n); + p = salloc_r (current_unit->s, &n); + + if (n == 0) + return; /* end of file */ if (p == NULL || n != sizeof (gfc_offset)) { @@ -817,7 +854,8 @@ return; } - current_unit->bytes_left = *p; + memcpy (&i, p, sizeof (gfc_offset)); + current_unit->bytes_left = i; } @@ -827,11 +865,11 @@ static void us_write (void) { - gfc_offset *p; + char *p; int length; length = sizeof (gfc_offset); - p = (gfc_offset *) salloc_w (current_unit->s, &length); + p = salloc_w (current_unit->s, &length); if (p == NULL) { @@ -839,7 +877,7 @@ return; } - *p = 0; /* Bogus value for now. */ + memset (p, '\0', sizeof (gfc_offset)); /* Bogus value for now. */ if (sfree (current_unit->s) == FAILURE) generate_error (ERROR_OS, NULL); @@ -859,7 +897,6 @@ static void pre_position (void) { - if (current_unit->current_record) return; /* Already positioned. */ @@ -900,6 +937,12 @@ current_unit = get_unit (read_flag); if (current_unit == NULL) { /* Open the unit with some default flags. */ + if (ioparm.unit < 0) + { + generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement"); + library_end (); + return; + } memset (&u_flags, '\0', sizeof (u_flags)); u_flags.access = ACCESS_SEQUENTIAL; u_flags.action = ACTION_READWRITE; @@ -1006,7 +1049,7 @@ if (read_flag) { - if (ioparm.eor != 0 && advance_status == ADVANCE_NO) + if (ioparm.eor != 0 && advance_status != ADVANCE_NO) generate_error (ERROR_MISSING_OPTION, "EOR specification requires an ADVANCE specification of NO"); @@ -1062,6 +1105,13 @@ generate_error (ERROR_OS, NULL); } + /* Overwriting an existing sequential file ? + it is always safe to truncate the file on the first write */ + if (g.mode == WRITING + && current_unit->flags.access == ACCESS_SEQUENTIAL + && current_unit->current_record == 0) + struncate(current_unit->s); + current_unit->mode = g.mode; /* Set the initial value of flags. */ @@ -1073,6 +1123,7 @@ g.first_item = 1; g.item_count = 0; sf_seen_eor = 0; + eor_condition = 0; pre_position (); @@ -1126,9 +1177,7 @@ /* Start the data transfer if we are doing a formatted transfer. */ if (current_unit->flags.form == FORM_FORMATTED && !ioparm.list_format && ioparm.namelist_name == NULL && ionml == NULL) - - formatted_transfer (0, NULL, 0); - + formatted_transfer (0, NULL, 0); } @@ -1189,8 +1238,12 @@ case FORMATTED_SEQUENTIAL: length = 1; - if (sf_seen_eor && done) - break; + /* sf_read has already terminated input because of an '\n' */ + if (sf_seen_eor) + { + sf_seen_eor=0; + break; + } do { @@ -1268,6 +1321,7 @@ goto io_error; *((gfc_offset *) p) = m; + memcpy (p, &m, sizeof (gfc_offset)); if (sfree (current_unit->s) == FAILURE) goto io_error; @@ -1278,7 +1332,7 @@ if (p == NULL) generate_error (ERROR_OS, NULL); - *((gfc_offset *) p) = m; + memcpy (p, &m, sizeof (gfc_offset)); if (sfree (current_unit->s) == FAILURE) goto io_error; @@ -1330,6 +1384,9 @@ else next_record_w (done); + /* keep position up to date for INQUIRE */ + current_unit->flags.position = POSITION_ASIS; + current_unit->current_record = 0; if (current_unit->flags.access == ACCESS_DIRECT) { @@ -1354,6 +1411,16 @@ finalize_transfer (void) { + if (eor_condition) + { + generate_error (ERROR_EOR, NULL); + return; + } + + if (ioparm.library_return != LIBRARY_OK) + return; + + if ((ionml != NULL) && (ioparm.namelist_name != NULL)) { if (ioparm.namelist_read_mode) @@ -1520,9 +1587,13 @@ current_unit->endfile = AT_ENDFILE; /* Just at it now. */ break; - case NO_ENDFILE: /* Get rid of whatever is after this record. */ - if (struncate (current_unit->s) == FAILURE) - generate_error (ERROR_OS, NULL); + case NO_ENDFILE: + if (current_unit->current_record > current_unit->last_record) + { + /* Get rid of whatever is after this record. */ + if (struncate (current_unit->s) == FAILURE) + generate_error (ERROR_OS, NULL); + } current_unit->endfile = AT_ENDFILE; break;