From: jvdelisle Date: Sun, 23 Apr 2006 02:04:58 +0000 (+0000) Subject: 2006-04-22 Jerry DeLisle X-Git-Tag: upstream/4.9.2~54856 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=46ca759c2a4e76679b3bc4957c816971c890e692;p=platform%2Fupstream%2Flinaro-gcc.git 2006-04-22 Jerry DeLisle PR libgfortran/20257 * io/io.h: Add prototypes for get_internal_unit and free_internal_unit. * io/unit.c (get_internal_unit): Initialize unit number, not zero. (free_internal_unit): New function to consolidate freeing memory. (get_unit): Initialize internal_unit_desc to NULL when unit is external. * io/unix.c (mem_close): Check for not NULL before freeing memory. * io/transfer.c (read_block): Reset bytes_left and skip error if unit is preconnected and default record length is reached. (read_block_direct): Ditto. (write_block): Ditto. (write_buf): Ditto. (data_transfer_init): Only flush if not internal unit. (finalize_transfer): Ditto and delete code to free memory used by internal units. (st_read_done): Use new function - free_internal_unit. (st_write_done): Use new function - free_internal unit. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@113190 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index bd02bbd..00acecf 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,23 @@ +2006-04-22 Jerry DeLisle + + PR libgfortran/20257 + * io/io.h: Add prototypes for get_internal_unit and free_internal_unit. + * io/unit.c (get_internal_unit): Initialize unit number, not zero. + (free_internal_unit): New function to consolidate freeing memory. + (get_unit): Initialize internal_unit_desc to NULL when unit is + external. + * io/unix.c (mem_close): Check for not NULL before freeing memory. + * io/transfer.c (read_block): Reset bytes_left and skip error if unit + is preconnected and default record length is reached. + (read_block_direct): Ditto. + (write_block): Ditto. + (write_buf): Ditto. + (data_transfer_init): Only flush if not internal unit. + (finalize_transfer): Ditto and delete code to free memory used by + internal units. + (st_read_done): Use new function - free_internal_unit. + (st_write_done): Use new function - free_internal unit. + 2006-04-22 Jakub Jelinek PR fortran/26769 diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index eed15ae..e7581a6 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -702,6 +702,12 @@ internal_proto(unit_lock); extern int close_unit (gfc_unit *); internal_proto(close_unit); +extern gfc_unit *get_internal_unit (st_parameter_dt *); +internal_proto(get_internal_unit); + +extern void free_internal_unit (st_parameter_dt *); +internal_proto(free_internal_unit); + extern int is_internal_unit (st_parameter_dt *); internal_proto(is_internal_unit); diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 11be456..7438401 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -257,11 +257,19 @@ read_block (st_parameter_dt *dtp, int *length) if (dtp->u.p.current_unit->bytes_left < *length) { - if (dtp->u.p.current_unit->flags.pad == PAD_NO) + /* For preconnected units with default record length, set bytes left + to unit record length and proceed, otherwise error. */ + if (dtp->u.p.current_unit->unit_number == options.stdin_unit + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + else { - generate_error (&dtp->common, ERROR_EOR, NULL); - /* Not enough data left. */ - return NULL; + if (dtp->u.p.current_unit->flags.pad == PAD_NO) + { + /* Not enough data left. */ + generate_error (&dtp->common, ERROR_EOR, NULL); + return NULL; + } } *length = dtp->u.p.current_unit->bytes_left; @@ -305,11 +313,19 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) if (dtp->u.p.current_unit->bytes_left < *nbytes) { - if (dtp->u.p.current_unit->flags.pad == PAD_NO) + /* For preconnected units with default record length, set bytes left + to unit record length and proceed, otherwise error. */ + if (dtp->u.p.current_unit->unit_number == options.stdin_unit + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + else { - /* Not enough data left. */ - generate_error (&dtp->common, ERROR_EOR, NULL); - return; + if (dtp->u.p.current_unit->flags.pad == PAD_NO) + { + /* Not enough data left. */ + generate_error (&dtp->common, ERROR_EOR, NULL); + return; + } } *nbytes = dtp->u.p.current_unit->bytes_left; @@ -358,11 +374,20 @@ void * write_block (st_parameter_dt *dtp, int length) { char *dest; - + if (dtp->u.p.current_unit->bytes_left < length) { - generate_error (&dtp->common, ERROR_EOR, NULL); - return NULL; + /* For preconnected units with default record length, set bytes left + to unit record length and proceed, otherwise error. */ + if ((dtp->u.p.current_unit->unit_number == options.stdout_unit + || dtp->u.p.current_unit->unit_number == options.stderr_unit) + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; + else + { + generate_error (&dtp->common, ERROR_EOR, NULL); + return NULL; + } } dtp->u.p.current_unit->bytes_left -= (gfc_offset) length; @@ -388,11 +413,20 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) { if (dtp->u.p.current_unit->bytes_left < nbytes) { - if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) - generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL); + /* For preconnected units with default record length, set bytes left + to unit record length and proceed, otherwise error. */ + if ((dtp->u.p.current_unit->unit_number == options.stdout_unit + || dtp->u.p.current_unit->unit_number == options.stderr_unit) + && dtp->u.p.current_unit->recl == DEFAULT_RECL) + dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else - generate_error (&dtp->common, ERROR_EOR, NULL); - return FAILURE; + { + if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) + generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL); + else + generate_error (&dtp->common, ERROR_EOR, NULL); + return FAILURE; + } } dtp->u.p.current_unit->bytes_left -= (gfc_offset) nbytes; @@ -1592,7 +1626,9 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) /* Check to see if we might be reading what we wrote before */ - if (dtp->u.p.mode == READING && dtp->u.p.current_unit->mode == WRITING) + if (dtp->u.p.mode == READING + && dtp->u.p.current_unit->mode == WRITING + && !is_internal_unit (dtp)) flush(dtp->u.p.current_unit->s); /* Check whether the record exists to be read. Only @@ -2186,7 +2222,8 @@ finalize_transfer (st_parameter_dt *dtp) { /* Most systems buffer lines, so force the partial record to be written out. */ - flush (dtp->u.p.current_unit->s); + if (!is_internal_unit (dtp)) + flush (dtp->u.p.current_unit->s); dtp->u.p.seen_dollar = 0; return; } @@ -2195,16 +2232,8 @@ finalize_transfer (st_parameter_dt *dtp) } sfree (dtp->u.p.current_unit->s); - - if (is_internal_unit (dtp)) - { - if (is_array_io (dtp) && dtp->u.p.current_unit->ls != NULL) - free_mem (dtp->u.p.current_unit->ls); - sclose (dtp->u.p.current_unit->s); - } } - /* Transfer function for IOLENGTH. It doesn't actually do any data transfer, it just updates the length counter. */ @@ -2318,8 +2347,9 @@ st_read_done (st_parameter_dt *dtp) free_mem (dtp->u.p.scratch); if (dtp->u.p.current_unit != NULL) unlock_unit (dtp->u.p.current_unit); - if (is_internal_unit (dtp) && dtp->u.p.current_unit != NULL) - free_mem (dtp->u.p.current_unit); + + free_internal_unit (dtp); + library_end (); } @@ -2372,8 +2402,9 @@ st_write_done (st_parameter_dt *dtp) free_mem (dtp->u.p.scratch); if (dtp->u.p.current_unit != NULL) unlock_unit (dtp->u.p.current_unit); - if (is_internal_unit (dtp) && dtp->u.p.current_unit != NULL) - free_mem (dtp->u.p.current_unit); + + free_internal_unit (dtp); + library_end (); } diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 81b128e..14438f8 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -378,6 +378,11 @@ get_internal_unit (st_parameter_dt *dtp) memset (iunit, '\0', sizeof (gfc_unit)); iunit->recl = dtp->internal_unit_len; + + /* For internal units we set the unit number to -1. + Otherwise internal units can be mistaken for a pre-connected unit or + some other file I/O unit. */ + iunit->unit_number = -1; /* Set up the looping specification from the array descriptor, if any. */ @@ -424,6 +429,23 @@ get_internal_unit (st_parameter_dt *dtp) } +/* free_internal_unit()-- Free memory allocated for internal units if any. */ +void +free_internal_unit (st_parameter_dt *dtp) +{ + if (!is_internal_unit (dtp)) + return; + + if (dtp->u.p.current_unit->ls != NULL) + free_mem (dtp->u.p.current_unit->ls); + + sclose (dtp->u.p.current_unit->s); + + if (dtp->u.p.current_unit != NULL) + free_mem (dtp->u.p.current_unit); +} + + /* get_unit()-- Returns the unit structure associated with the integer * unit or the internal file. */ @@ -437,6 +459,7 @@ get_unit (st_parameter_dt *dtp, int do_create) /* Has to be an external unit */ dtp->u.p.unit_is_internal = 0; + dtp->internal_unit_desc = NULL; return get_external_unit (dtp->common.unit, do_create); } diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index 550ddab..93f4ea6 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -928,7 +928,8 @@ mem_truncate (unix_stream * s __attribute__ ((unused))) static try mem_close (unix_stream * s) { - free_mem (s); + if (s != NULL) + free_mem (s); return SUCCESS; }