-/* Copyright (C) 2002, 2003, 2005, 2007, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2005, 2007, 2008, 2009, 2010
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
F2003 I/O support contributed by Jerry DeLisle
-This file is part of the GNU Fortran 95 runtime library (libgfortran).
+This file is part of the GNU Fortran runtime library (libgfortran).
Libgfortran is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
<http://www.gnu.org/licenses/>. */
#include "io.h"
+#include "fbuf.h"
+#include "format.h"
+#include "unix.h"
#include <stdlib.h>
#include <string.h>
destroy_unit_mutex (gfc_unit * u)
{
__gthread_mutex_destroy (&u->lock);
- free_mem (u);
+ free (u);
}
}
/* Set initial values for unit parameters. */
+ if (dtp->common.unit)
+ {
+ iunit->s = open_internal4 (dtp->internal_unit - start_record,
+ dtp->internal_unit_len, -start_record);
+ fbuf_init (iunit, 256);
+ }
+ else
+ iunit->s = open_internal (dtp->internal_unit - start_record,
+ dtp->internal_unit_len, -start_record);
- iunit->s = open_internal (dtp->internal_unit - start_record,
- dtp->internal_unit_len, -start_record);
iunit->bytes_left = iunit->recl;
iunit->last_record=0;
iunit->maxrec=0;
if (!is_internal_unit (dtp))
return;
+ if (unlikely (is_char4_unit (dtp)))
+ fbuf_destroy (dtp->u.p.current_unit);
+
if (dtp->u.p.current_unit != NULL)
{
- if (dtp->u.p.current_unit->ls != NULL)
- free_mem (dtp->u.p.current_unit->ls);
+ free (dtp->u.p.current_unit->ls);
- if (dtp->u.p.current_unit->s)
- free_mem (dtp->u.p.current_unit->s);
+ free (dtp->u.p.current_unit->s);
destroy_unit_mutex (dtp->u.p.current_unit);
}
{
if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0)
- return get_internal_unit(dtp);
+ return get_internal_unit (dtp);
/* Has to be an external unit. */
delete_unit (u);
- if (u->file)
- free_mem (u->file);
+ free (u->file);
u->file = NULL;
u->file_len = 0;
void
update_position (gfc_unit *u)
{
- if (stell (u->s) == 0)
+ /* If unit is not seekable, this makes no sense (and the standard is
+ silent on this matter), and thus we don't change the position for
+ a non-seekable file. */
+ gfc_offset cur = stell (u->s);
+ if (cur == -1)
+ return;
+ else if (cur == 0)
u->flags.position = POSITION_REWIND;
- else if (file_length (u->s) == stell (u->s))
+ else if (file_length (u->s) == cur)
u->flags.position = POSITION_APPEND;
else
u->flags.position = POSITION_ASIS;
}
-/* High level interface to truncate a file safely, i.e. flush format
- buffers, check that it's a regular file, and generate error if that
- occurs. Just like POSIX ftruncate, returns 0 on success, -1 on
- failure. */
+/* High level interface to truncate a file, i.e. flush format buffers,
+ and generate an error or set some flags. Just like POSIX
+ ftruncate, returns 0 on success, -1 on failure. */
int
unit_truncate (gfc_unit * u, gfc_offset pos, st_parameter_common * common)
fbuf_flush (u, u->mode);
}
- /* Don't try to truncate a special file, just pretend that it
- succeeds. */
- if (is_special (u->s) || !is_seekable (u->s))
- {
- sflush (u->s);
- return 0;
- }
-
/* struncate() should flush the stream buffer if necessary, so don't
bother calling sflush() here. */
ret = struncate (u->s, pos);
if (ret != 0)
- {
- generate_error (common, LIBERROR_OS, NULL);
- u->endfile = NO_ENDFILE;
- u->flags.position = POSITION_ASIS;
- }
+ generate_error (common, LIBERROR_OS, NULL);
else
{
u->endfile = AT_ENDFILE;