re PR fortran/26766 ([F2003] Recursive I/O still (again) broken)
2006-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR libgfortran/26766 * io/io.h: Add bit to identify associated unit as internal. * io/unit.c (get_external_unit): Renamed the find_unit_1 function to reflect the external unit functionality vs internal unit. (get_internal_unit): New function to allocate and initialize an internal unit structure. (get_unit): Use get_internal_unit and get_external_unit. (is_internal_unit): Revised to use new bit added in io.h. * io/transfer.c (data_transfer_init): Fix line width. (st_read_done): Free memory allocated for internal unit. (st_write_done): Add test to only flush and truncate when not an internal unit. Free memory allocated for internal unit. From-SVN: r112914
This commit is contained in:
parent
7b5d92b270
commit
6f34d6e078
|
@ -1,3 +1,18 @@
|
||||||
|
2006-04-12 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR libgfortran/26766
|
||||||
|
* io/io.h: Add bit to identify associated unit as internal.
|
||||||
|
* io/unit.c (get_external_unit): Renamed the find_unit_1 function to
|
||||||
|
reflect the external unit functionality vs internal unit.
|
||||||
|
(get_internal_unit): New function to allocate and initialize an internal
|
||||||
|
unit structure.
|
||||||
|
(get_unit): Use get_internal_unit and get_external_unit.
|
||||||
|
(is_internal_unit): Revised to use new bit added in io.h.
|
||||||
|
* io/transfer.c (data_transfer_init): Fix line width.
|
||||||
|
(st_read_done): Free memory allocated for internal unit.
|
||||||
|
(st_write_done): Add test to only flush and truncate when not an
|
||||||
|
internal unit. Free memory allocated for internal unit.
|
||||||
|
|
||||||
2006-04-11 Jakub Jelinek <jakub@redhat.com>
|
2006-04-11 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
* io/io.h (st_parameter_dt): Revert 2005-12-10 change to
|
* io/io.h (st_parameter_dt): Revert 2005-12-10 change to
|
||||||
|
|
|
@ -414,7 +414,10 @@ typedef struct st_parameter_dt
|
||||||
/* A namelist specific flag used to enable reading input from
|
/* A namelist specific flag used to enable reading input from
|
||||||
line_buffer for logical reads. */
|
line_buffer for logical reads. */
|
||||||
unsigned line_buffer_enabled : 1;
|
unsigned line_buffer_enabled : 1;
|
||||||
/* 18 unused bits. */
|
/* An internal unit specific flag used to identify that the associated
|
||||||
|
unit is internal. */
|
||||||
|
unsigned unit_is_internal : 1;
|
||||||
|
/* 17 unused bits. */
|
||||||
|
|
||||||
char last_char;
|
char last_char;
|
||||||
char nml_delim;
|
char nml_delim;
|
||||||
|
|
|
@ -1619,7 +1619,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
|
||||||
it is always safe to truncate the file on the first write */
|
it is always safe to truncate the file on the first write */
|
||||||
if (dtp->u.p.mode == WRITING
|
if (dtp->u.p.mode == WRITING
|
||||||
&& dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL
|
&& dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL
|
||||||
&& dtp->u.p.current_unit->last_record == 0 && !is_preconnected(dtp->u.p.current_unit->s))
|
&& dtp->u.p.current_unit->last_record == 0
|
||||||
|
&& !is_preconnected(dtp->u.p.current_unit->s))
|
||||||
struncate(dtp->u.p.current_unit->s);
|
struncate(dtp->u.p.current_unit->s);
|
||||||
|
|
||||||
/* Bugware for badly written mixed C-Fortran I/O. */
|
/* Bugware for badly written mixed C-Fortran I/O. */
|
||||||
|
@ -2317,6 +2318,8 @@ st_read_done (st_parameter_dt *dtp)
|
||||||
free_mem (dtp->u.p.scratch);
|
free_mem (dtp->u.p.scratch);
|
||||||
if (dtp->u.p.current_unit != NULL)
|
if (dtp->u.p.current_unit != NULL)
|
||||||
unlock_unit (dtp->u.p.current_unit);
|
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);
|
||||||
library_end ();
|
library_end ();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -2353,10 +2356,12 @@ st_write_done (st_parameter_dt *dtp)
|
||||||
|
|
||||||
case NO_ENDFILE:
|
case NO_ENDFILE:
|
||||||
/* Get rid of whatever is after this record. */
|
/* Get rid of whatever is after this record. */
|
||||||
flush (dtp->u.p.current_unit->s);
|
if (!is_internal_unit (dtp))
|
||||||
if (struncate (dtp->u.p.current_unit->s) == FAILURE)
|
{
|
||||||
generate_error (&dtp->common, ERROR_OS, NULL);
|
flush (dtp->u.p.current_unit->s);
|
||||||
|
if (struncate (dtp->u.p.current_unit->s) == FAILURE)
|
||||||
|
generate_error (&dtp->common, ERROR_OS, NULL);
|
||||||
|
}
|
||||||
dtp->u.p.current_unit->endfile = AT_ENDFILE;
|
dtp->u.p.current_unit->endfile = AT_ENDFILE;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
@ -2367,6 +2372,8 @@ st_write_done (st_parameter_dt *dtp)
|
||||||
free_mem (dtp->u.p.scratch);
|
free_mem (dtp->u.p.scratch);
|
||||||
if (dtp->u.p.current_unit != NULL)
|
if (dtp->u.p.current_unit != NULL)
|
||||||
unlock_unit (dtp->u.p.current_unit);
|
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);
|
||||||
library_end ();
|
library_end ();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -75,7 +75,7 @@ Boston, MA 02110-1301, USA. */
|
||||||
|
|
||||||
|
|
||||||
#define CACHE_SIZE 3
|
#define CACHE_SIZE 3
|
||||||
static gfc_unit internal_unit, *unit_cache[CACHE_SIZE];
|
static gfc_unit *unit_cache[CACHE_SIZE];
|
||||||
gfc_offset max_offset;
|
gfc_offset max_offset;
|
||||||
gfc_unit *unit_root;
|
gfc_unit *unit_root;
|
||||||
#ifdef __GTHREAD_MUTEX_INIT
|
#ifdef __GTHREAD_MUTEX_INIT
|
||||||
|
@ -260,12 +260,12 @@ delete_unit (gfc_unit * old)
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* find_unit()-- Given an integer, return a pointer to the unit
|
/* get_external_unit()-- Given an integer, return a pointer to the unit
|
||||||
* structure. Returns NULL if the unit does not exist,
|
* structure. Returns NULL if the unit does not exist,
|
||||||
* otherwise returns a locked unit. */
|
* otherwise returns a locked unit. */
|
||||||
|
|
||||||
static gfc_unit *
|
static gfc_unit *
|
||||||
find_unit_1 (int n, int do_create)
|
get_external_unit (int n, int do_create)
|
||||||
{
|
{
|
||||||
gfc_unit *p;
|
gfc_unit *p;
|
||||||
int c, created = 0;
|
int c, created = 0;
|
||||||
|
@ -346,58 +346,99 @@ found:
|
||||||
return p;
|
return p;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
gfc_unit *
|
gfc_unit *
|
||||||
find_unit (int n)
|
find_unit (int n)
|
||||||
{
|
{
|
||||||
return find_unit_1 (n, 0);
|
return get_external_unit (n, 0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
gfc_unit *
|
gfc_unit *
|
||||||
find_or_create_unit (int n)
|
find_or_create_unit (int n)
|
||||||
{
|
{
|
||||||
return find_unit_1 (n, 1);
|
return get_external_unit (n, 1);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
gfc_unit *
|
||||||
|
get_internal_unit (st_parameter_dt *dtp)
|
||||||
|
{
|
||||||
|
gfc_unit * iunit;
|
||||||
|
|
||||||
|
/* Allocate memory for a unit structure. */
|
||||||
|
|
||||||
|
iunit = get_mem (sizeof (gfc_unit));
|
||||||
|
if (iunit == NULL)
|
||||||
|
{
|
||||||
|
generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL);
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
|
||||||
|
memset (iunit, '\0', sizeof (gfc_unit));
|
||||||
|
|
||||||
|
iunit->recl = dtp->internal_unit_len;
|
||||||
|
|
||||||
|
/* Set up the looping specification from the array descriptor, if any. */
|
||||||
|
|
||||||
|
if (is_array_io (dtp))
|
||||||
|
{
|
||||||
|
iunit->rank = GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc);
|
||||||
|
iunit->ls = (array_loop_spec *)
|
||||||
|
get_mem (iunit->rank * sizeof (array_loop_spec));
|
||||||
|
dtp->internal_unit_len *=
|
||||||
|
init_loop_spec (dtp->internal_unit_desc, iunit->ls);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Set initial values for unit parameters. */
|
||||||
|
|
||||||
|
iunit->s = open_internal (dtp->internal_unit, dtp->internal_unit_len);
|
||||||
|
iunit->bytes_left = iunit->recl;
|
||||||
|
iunit->last_record=0;
|
||||||
|
iunit->maxrec=0;
|
||||||
|
iunit->current_record=0;
|
||||||
|
iunit->read_bad = 0;
|
||||||
|
|
||||||
|
/* Set flags for the internal unit. */
|
||||||
|
|
||||||
|
iunit->flags.access = ACCESS_SEQUENTIAL;
|
||||||
|
iunit->flags.action = ACTION_READWRITE;
|
||||||
|
iunit->flags.form = FORM_FORMATTED;
|
||||||
|
iunit->flags.pad = PAD_YES;
|
||||||
|
iunit->flags.status = STATUS_UNSPECIFIED;
|
||||||
|
|
||||||
|
/* Initialize the data transfer parameters. */
|
||||||
|
|
||||||
|
dtp->u.p.advance_status = ADVANCE_YES;
|
||||||
|
dtp->u.p.blank_status = BLANK_UNSPECIFIED;
|
||||||
|
dtp->u.p.seen_dollar = 0;
|
||||||
|
dtp->u.p.skips = 0;
|
||||||
|
dtp->u.p.pending_spaces = 0;
|
||||||
|
dtp->u.p.max_pos = 0;
|
||||||
|
|
||||||
|
/* This flag tells us the unit is assigned to internal I/O. */
|
||||||
|
|
||||||
|
dtp->u.p.unit_is_internal = 1;
|
||||||
|
|
||||||
|
return iunit;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
/* get_unit()-- Returns the unit structure associated with the integer
|
/* get_unit()-- Returns the unit structure associated with the integer
|
||||||
* unit or the internal file. */
|
* unit or the internal file. */
|
||||||
|
|
||||||
gfc_unit *
|
gfc_unit *
|
||||||
get_unit (st_parameter_dt *dtp, int do_create)
|
get_unit (st_parameter_dt *dtp, int do_create)
|
||||||
{
|
{
|
||||||
|
|
||||||
if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0)
|
if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0)
|
||||||
{
|
return get_internal_unit(dtp);
|
||||||
__gthread_mutex_lock (&internal_unit.lock);
|
|
||||||
internal_unit.recl = dtp->internal_unit_len;
|
|
||||||
if (is_array_io (dtp))
|
|
||||||
{
|
|
||||||
internal_unit.rank = GFC_DESCRIPTOR_RANK (dtp->internal_unit_desc);
|
|
||||||
internal_unit.ls = (array_loop_spec *)
|
|
||||||
get_mem (internal_unit.rank * sizeof (array_loop_spec));
|
|
||||||
dtp->internal_unit_len *=
|
|
||||||
init_loop_spec (dtp->internal_unit_desc, internal_unit.ls);
|
|
||||||
}
|
|
||||||
|
|
||||||
internal_unit.s =
|
|
||||||
open_internal (dtp->internal_unit, dtp->internal_unit_len);
|
|
||||||
internal_unit.bytes_left = internal_unit.recl;
|
|
||||||
internal_unit.last_record=0;
|
|
||||||
internal_unit.maxrec=0;
|
|
||||||
internal_unit.current_record=0;
|
|
||||||
|
|
||||||
/* Set flags for the internal unit */
|
|
||||||
|
|
||||||
internal_unit.flags.access = ACCESS_SEQUENTIAL;
|
|
||||||
internal_unit.flags.action = ACTION_READWRITE;
|
|
||||||
internal_unit.flags.form = FORM_FORMATTED;
|
|
||||||
internal_unit.flags.delim = DELIM_NONE;
|
|
||||||
internal_unit.flags.pad = PAD_YES;
|
|
||||||
|
|
||||||
return &internal_unit;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Has to be an external unit */
|
/* Has to be an external unit */
|
||||||
|
|
||||||
return find_unit_1 (dtp->common.unit, do_create);
|
dtp->u.p.unit_is_internal = 0;
|
||||||
|
|
||||||
|
return get_external_unit (dtp->common.unit, do_create);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -406,7 +447,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
|
||||||
int
|
int
|
||||||
is_internal_unit (st_parameter_dt *dtp)
|
is_internal_unit (st_parameter_dt *dtp)
|
||||||
{
|
{
|
||||||
return dtp->u.p.current_unit == &internal_unit;
|
return dtp->u.p.unit_is_internal;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -432,15 +473,6 @@ init_units (void)
|
||||||
__GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock);
|
__GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#ifdef __GTHREAD_MUTEX_INIT
|
|
||||||
{
|
|
||||||
__gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;
|
|
||||||
internal_unit.lock = tmp;
|
|
||||||
}
|
|
||||||
#else
|
|
||||||
__GTHREAD_MUTEX_INIT_FUNCTION (&internal_unit.lock);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
if (options.stdin_unit >= 0)
|
if (options.stdin_unit >= 0)
|
||||||
{ /* STDIN */
|
{ /* STDIN */
|
||||||
u = insert_unit (options.stdin_unit);
|
u = insert_unit (options.stdin_unit);
|
||||||
|
|
Loading…
Reference in New Issue