From cac2dbea80c45791e2e877d4a2cde92f9a79a5e1 Mon Sep 17 00:00:00 2001 From: jvdelisle Date: Thu, 11 Mar 2010 02:15:33 +0000 Subject: [PATCH] 2010-03-10 Jerry DeLisle PR libfortran/43320 * io/transfer.c (next_record_r): Add hit_eof based on item_count condition. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@157377 138bc75d-0d04-0410-961f-82ee72b054a4 --- libgfortran/ChangeLog | 176 ---------------------------------------------- libgfortran/io/transfer.c | 110 +++++++++-------------------- 2 files changed, 33 insertions(+), 253 deletions(-) diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index e90848cf57f..e496264c6bc 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,179 +1,3 @@ -2010-05-20 Jerry DeLisle - - PR fortran/43851 - * runtime/stop.c (stop_string): Make sure nothing is emitted for - blank stop. - -2010-05-19 Jerry DeLisle - - PR fortran/43851 - * runtime/stop.c (error_stop_numeric): New function and updated comment. - Add declaration for stop_numeric and remove declaration for stop_string. - (stop_string): Use for blank STOP. - (stop_numeric): Remove use of special -1 stop code. - * runtime/pause.c (do_pause): Use stop_string for blank stop. - (pause_numeric): Remove use of special -1 pause code. - * gfortran.map: Add new symbol to run-time library. - * libgfortran.h: Move declaration for stop_string to here to make - function visible for do_pause. Remove declaration for stop_numeric. - -2010-05-08 Janne Blomqvist - - * io/unix.h (mem_alloc_r): Fix typo to reduce visibility. - -2010-05-07 Janne Blomqvist - - * libgfortran.h (free_mem): Remove prototype. - * runtime/memory.c (free_mem): Remove function. - * intrinsics/date_and_time.c (secnds): Replace free_mem() with - free(). - * io/fbuf.c (fbuf_destroy): Likewise. - * io/format.c (free_format_hash_table): Likewise. - (save_parsed_format): Likewise. - (free_format_data): Likewise. - * io/list_read.c (free_saved): Likewise. - (free_line): Likewise. - (nml_touch_nodes): Likewise. - (nml_read_obj): Likewise - * io/lock.c (free_ionml): Likewise. - * io/open.c (new_unit): Likewise. - (already_open): Likewise. - * io/unit.c (destroy_unit_mutex): Likewise. - (free_internal_unit): Likewise. - (close_unit_1): Likewise. - * io/unix.c (raw_close): Likewise. - (buf_close): Likewise. - (mem_close): Likewise. - (tempfile): Likewise. - * io/write.c (nml_write_obj): Likewise. - * io/write_float.def (output_float_FMT_G_##): Likewise. - * runtime/error.c (show_locus): Likewise. - -2010-05-04 Ralf Wildenhues - - PR other/43620 - * configure.ac (AM_INIT_AUTOMAKE): Add no-dist. - * configure: Regenerate. - * Makefile.in: Regenerate. - -2010-04-30 Kai Tietz - - PR/43844 - * io/unix.c (raw_truncate): Explicit cast from integer-scalar - to pointer. - (tempfile): Use for mingw GetTempPath and avoid double slash - for path. - -2010-04-24 Kai Tietz - - PR/43844 - * io/unix.c (tempfile): Correct logic for mktemp case. - -2010-04-06 Tobias Burnus - - PR fortran/39997 - * runtime/stop.c (error_stop_string): New function. - * gfortran.map (_gfortran_error_stop_string): Add. - -2010-04-02 Ralf Wildenhues - - * Makefile.in: Regenerate. - * aclocal.m4: Regenerate. - -2010-04-01 Janne Blomqvist - - PR libfortran/43605 - * io/intrinsics.c (gf_ftell): New function, seek to correct offset. - (ftell): Call gf_ftell. - (FTELL_SUB): Likewise. - -2010-04-01 Paul Thomas - - * io/transfer.c : Update copyright. - * io/unix.c : ditto - * io/read.c : ditto - * io/io.h : ditto - * io/unix.h : ditto - * io/inquire.c : ditto - * io/format.c : ditto - * io/list_read.c : ditto - * runtime/error.c : ditto - * libgfortran.h : ditto - * intrinsics/date_and_time.c: ditto - * intrinsics/args.c : ditto - -2010-04-01 Janne Blomqvist - - PR libfortran/43605 - * io/intrinsics.c (ftell): Reset fbuf, correct offset. - (FTELL_SUB): Likewise. - -2010-03-29 Jerry DeLisle - - PR libfortran/43265 - * io/transfer.c (next_record_r): Only call hit_eof for specific - conditions when an EOF is encountered. - -2010-03-29 Tobias Burnus - - PR fortran/43551 - * io/unix.c (buf_write): Set physical_offset after lseek. - -2010-03-25 Jerry DeLisle - - PR libfortran/43517 - * io/read.c (read_x): Return if seen EOR condition. - -2010-03-21 Jerry DeLisle - - PR fortran/43409 - * io/io.h: Fix type of size in st_parameter_inquire structure. - -2010-03-20 Jerry DeLisle - - PR fortran/43409 - * io/unix.h: Add prototype for new function to return file size. - * io/unix.c (file_size): New function. - * io/inquire.c (inquire_via_unit): Use new function. - (inquire_via_filename): Use new function. - -2010-03-17 Jerry DeLisle - - * io/transfer.c (read_sf_internal): Remove stray function declaration - used during debugging. - -2010-03-17 Jerry DeLisle - - PR libfortran/43265 - * io/io.h: Delete prototype for read_sf, making it static. - * io/read.c (read_x): Modify to call hit_eof if PAD="no". - * io/transfer.c (read_sf_internal): New static function extracted from - read_sf for use on internal units only. Handle empty string case. - (read_sf): New factoring of this function, make it static. Add special - conditions for EOF based on ADVANCE="no", PAD="no", and whether any - bytes have been previously read from the record. - (read_block_form): Modify to call read_sf or read_sf_internal. - (next_record_r): Add a done flag similar to next_record_w. Call hit_eof - if internal array unit next record returns finished, meaning an EOF was - found and not done, ie not the last record expected. For external - units call hit_eof if item_count is 1 or there are no pending spaces. - (next_record): Update call to next_record_r. - -2010-03-12 Kai Tietz - - PR/42950 - * io/format.c (parse_format_list): Add to ERROR, WARNING, - SILENT enumerators NOTIFICATION_ prefix. - * runtime/error.c (notification_std): Likewise. - * libgfortran.h (notification): Likewise. - (GFC_LARGEST_BUF): Check for HAVE_GFC_INTEGER_16. - -2010-03-11 Tobias Burnus - - PR fortran/43228 - * io/list_read.c (nml_parse_qualifier): Disable expanded_read - for array sections. - 2010-03-10 Jerry DeLisle PR libfortran/43320 diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 982d7d0b433..958ef656b73 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. Contributed by Andy Vaught Namelist transfer functions contributed by Paul Thomas @@ -175,7 +175,9 @@ current_mode (st_parameter_dt *dtp) } -/* Mid level data transfer statements. */ +/* Mid level data transfer statements. These subroutines do reading + and writing in the style of salloc_r()/salloc_w() within the + current record. */ /* When reading sequential formatted records we have a problem. We don't know how long the line is until we read the trailing newline, @@ -188,20 +190,13 @@ current_mode (st_parameter_dt *dtp) we hit the newline. For small allocations, we use a static buffer. For larger allocations, we are forced to allocate memory on the heap. Hopefully this won't happen very often. */ - -/* Read sequential file - internal unit */ -static char * -read_sf_internal (st_parameter_dt *dtp, int * length) +char * +read_sf (st_parameter_dt *dtp, int * length) { static char *empty_string[0]; - char *base; - int lorig; - - /* Zero size array gives internal unit len of 0. Nothing to read. */ - if (dtp->internal_unit_len == 0 - && dtp->u.p.current_unit->pad_status == PAD_NO) - hit_eof (dtp); + char *base, *p, q; + int n, lorig, memread, seen_comma; /* If we have seen an eor previously, return a length of 0. The caller is responsible for correctly padding the input field. */ @@ -213,40 +208,17 @@ read_sf_internal (st_parameter_dt *dtp, int * length) return (char*) empty_string; } - lorig = *length; - base = mem_alloc_r (dtp->u.p.current_unit->s, length); - if (unlikely (lorig > *length)) - { - hit_eof (dtp); - return NULL; - } - - dtp->u.p.current_unit->bytes_left -= *length; - - if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) - dtp->u.p.size_used += (GFC_IO_INT) *length; - - return base; - -} - -/* Read sequential file - external unit */ - -static char * -read_sf (st_parameter_dt *dtp, int * length) -{ - static char *empty_string[0]; - char *base, *p, q; - int n, lorig, seen_comma; - - /* If we have seen an eor previously, return a length of 0. The - caller is responsible for correctly padding the input field. */ - if (dtp->u.p.sf_seen_eor) + if (is_internal_unit (dtp)) { - *length = 0; - /* Just return something that isn't a NULL pointer, otherwise the - caller thinks an error occured. */ - return (char*) empty_string; + memread = *length; + base = mem_alloc_r (dtp->u.p.current_unit->s, length); + if (unlikely (memread > *length)) + { + hit_eof (dtp); + return NULL; + } + n = *length; + goto done; } n = seen_comma = 0; @@ -335,14 +307,11 @@ read_sf (st_parameter_dt *dtp, int * length) else dtp->u.p.at_eof = 1; } - else if (dtp->u.p.advance_status == ADVANCE_NO - || dtp->u.p.current_unit->pad_status == PAD_NO - || dtp->u.p.current_unit->bytes_left - == dtp->u.p.current_unit->recl) - { - hit_eof (dtp); - return NULL; - } + else + { + hit_eof (dtp); + return NULL; + } } done: @@ -383,8 +352,7 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { - if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO) - && !is_internal_unit (dtp)) + if (unlikely (dtp->u.p.current_unit->pad_status == PAD_NO)) { /* Not enough data left. */ generate_error (&dtp->common, LIBERROR_EOR, NULL); @@ -392,10 +360,9 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) } } - if (unlikely (dtp->u.p.current_unit->bytes_left == 0 - && !is_internal_unit(dtp))) + if (unlikely (dtp->u.p.current_unit->bytes_left == 0)) { - hit_eof (dtp); + hit_eof (dtp); return NULL; } @@ -407,11 +374,7 @@ read_block_form (st_parameter_dt *dtp, int * nbytes) (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL || dtp->u.p.current_unit->flags.access == ACCESS_STREAM)) { - if (is_internal_unit (dtp)) - source = read_sf_internal (dtp, nbytes); - else - source = read_sf (dtp, nbytes); - + source = read_sf (dtp, nbytes); dtp->u.p.current_unit->strm_pos += (gfc_offset) (*nbytes + dtp->u.p.sf_seen_eor); return source; @@ -2768,7 +2731,7 @@ min_off (gfc_offset a, gfc_offset b) /* Space to the next record for read mode. */ static void -next_record_r (st_parameter_dt *dtp, int done) +next_record_r (st_parameter_dt *dtp) { gfc_offset record; int bytes_left; @@ -2795,9 +2758,10 @@ next_record_r (st_parameter_dt *dtp, int done) case FORMATTED_SEQUENTIAL: /* read_sf has already terminated input because of an '\n', or we have hit EOF. */ - if (dtp->u.p.sf_seen_eor) + if (dtp->u.p.sf_seen_eor || dtp->u.p.at_eof) { dtp->u.p.sf_seen_eor = 0; + dtp->u.p.at_eof = 0; break; } @@ -2809,8 +2773,6 @@ next_record_r (st_parameter_dt *dtp, int done) record = next_array_record (dtp, dtp->u.p.current_unit->ls, &finished); - if (!done && finished) - hit_eof (dtp); /* Now seek to this record. */ record = record * dtp->u.p.current_unit->recl; @@ -2848,14 +2810,8 @@ next_record_r (st_parameter_dt *dtp, int done) { if (errno != 0) generate_error (&dtp->common, LIBERROR_OS, NULL); - else - { - if (is_stream_io (dtp) - || dtp->u.p.current_unit->pad_status == PAD_NO - || dtp->u.p.current_unit->bytes_left - == dtp->u.p.current_unit->recl) - hit_eof (dtp); - } + else if (dtp->u.p.item_count == 1) + hit_eof (dtp); break; } @@ -3195,7 +3151,7 @@ next_record (st_parameter_dt *dtp, int done) dtp->u.p.current_unit->read_bad = 0; if (dtp->u.p.mode == READING) - next_record_r (dtp, done); + next_record_r (dtp); else next_record_w (dtp, done); -- 2.11.0