-/* Copyright (C) 2002-2003, 2005, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2003, 2005, 2006, 2007, 2009 Free Software Foundation, Inc.
Contributed by Andy Vaught and Janne Blomqvist
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
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
-In addition to the permissions in the GNU General Public License, the
-Free Software Foundation gives you unlimited permission to link the
-compiled version of this file into combinations with other programs,
-and to distribute those combinations without any restriction coming
-from the use of this file. (The General Public License restrictions
-do apply in other respects; for example, they cover modification of
-the file, and distribution when not linked into a combine
-executable.)
-
Libgfortran is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
-You should have received a copy of the GNU General Public License
-along with Libgfortran; see the file COPYING. If not, write to
-the Free Software Foundation, 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
#include "io.h"
#include <string.h>
{
gfc_offset base;
char p[READ_CHUNK];
- size_t n;
+ ssize_t n;
- base = file_position (u->s) - 1;
+ base = stell (u->s) - 1;
do
{
n = (base < READ_CHUNK) ? base : READ_CHUNK;
base -= n;
- if (sseek (u->s, base) == FAILURE)
+ if (sseek (u->s, base, SEEK_SET) < 0)
goto io_error;
- if (sread (u->s, p, &n) != 0)
+ if (sread (u->s, p, n) != n)
goto io_error;
/* We have moved backwards from the current position, it should
/* base is the new pointer. Seek to it exactly. */
done:
- if (sseek (u->s, base) == FAILURE)
+ if (sseek (u->s, base, SEEK_SET) < 0)
goto io_error;
u->last_record--;
u->endfile = NO_ENDFILE;
static void
unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
{
- gfc_offset m, new;
+ gfc_offset m, slen;
GFC_INTEGER_4 m4;
GFC_INTEGER_8 m8;
- size_t length;
+ ssize_t length;
int continued;
char p[sizeof (GFC_INTEGER_8)];
do
{
- if (sseek (u->s, file_position (u->s) - length) == FAILURE)
+ slen = - (gfc_offset) length;
+ if (sseek (u->s, slen, SEEK_CUR) < 0)
goto io_error;
- if (sread (u->s, p, &length) != 0)
+ if (sread (u->s, p, length) != length)
goto io_error;
/* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
if (continued)
m = -m;
- if ((new = file_position (u->s) - m - 2*length) < 0)
- new = 0;
-
- if (sseek (u->s, new) == FAILURE)
+ if (sseek (u->s, -m -2 * length, SEEK_CUR) < 0)
goto io_error;
} while (continued);
goto done;
}
- if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED)
- {
- generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
- "Cannot BACKSPACE an unformatted stream file");
- goto done;
- }
+ if (u->flags.access == ACCESS_STREAM && u->flags.form == FORM_UNFORMATTED)
+ {
+ generate_error (&fpp->common, LIBERROR_OPTION_CONFLICT,
+ "Cannot BACKSPACE an unformatted stream file");
+ goto done;
+ }
+
+ /* Make sure format buffer is flushed and reset. */
+ if (u->flags.form == FORM_FORMATTED)
+ {
+ int pos = fbuf_reset (u);
+ if (pos != 0)
+ sseek (u->s, pos, SEEK_CUR);
+ }
- /* Make sure format buffer is flushed. */
- fbuf_flush (u, 1);
/* Check for special cases involving the ENDFILE record first. */
{
u->endfile = AT_ENDFILE;
u->flags.position = POSITION_APPEND;
- flush (u->s);
+ sflush (u->s);
}
else
{
- if (file_position (u->s) == 0)
+ if (stell (u->s) == 0)
{
u->flags.position = POSITION_REWIND;
goto done; /* Common special case */
u->previous_nonadvancing_write = 0;
- flush (u->s);
- struncate (u->s);
+ unit_truncate (u, stell (u->s), &fpp->common);
u->mode = READING;
}
else
unformatted_backspace (fpp, u);
- update_position (u);
+ u->flags.position = POSITION_UNSPECIFIED;
u->endfile = NO_ENDFILE;
u->current_record = 0;
u->bytes_left = 0;
{
st_parameter_dt dtp;
dtp.common = fpp->common;
- memset (&dtp.u.p.transfer, 0, sizeof (dtp.u.q));
+ memset (&dtp.u.p, 0, sizeof (dtp.u.p));
dtp.u.p.current_unit = u;
next_record (&dtp, 1);
}
- flush (u->s);
- struncate (u->s);
+ unit_truncate (u, stell (u->s), &fpp->common);
u->endfile = AFTER_ENDFILE;
- update_position (u);
+ if (0 == stell (u->s))
+ u->flags.position = POSITION_REWIND;
done:
unlock_unit (u);
}
written record is the last record in the file, so truncate the
file now. Reset to read mode so two consecutive rewind
statements do not delete the file contents. */
- flush (u->s);
- if (u->mode == WRITING && u->flags.access != ACCESS_STREAM)
- struncate (u->s);
+ if (u->mode == WRITING)
+ {
+ /* unit_truncate takes care of flushing. */
+ unit_truncate (u, stell (u->s), &fpp->common);
+ /* .. but we still need to reset since we're going to seek. */
+ fbuf_reset (u);
+ }
+ else
+ {
+ /* Make sure buffers are reset. */
+ if (u->flags.form == FORM_FORMATTED)
+ fbuf_reset (u);
+ sflush (u->s);
+ }
u->mode = READING;
u->last_record = 0;
- if (file_position (u->s) != 0 && sseek (u->s, 0) == FAILURE)
+ if (sseek (u->s, 0, SEEK_SET) < 0)
generate_error (&fpp->common, LIBERROR_OS, NULL);
/* Handle special files like /dev/null differently. */
else
{
/* Set this for compatibilty with g77 for /dev/null. */
- if (file_length (u->s) == 0 && file_position (u->s) == 0)
+ if (file_length (u->s) == 0 && stell (u->s) == 0)
u->endfile = AT_ENDFILE;
/* Future refinements on special files can go here. */
}
u = find_unit (fpp->common.unit);
if (u != NULL)
{
- flush (u->s);
+ /* Make sure format buffer is flushed. */
+ if (u->flags.form == FORM_FORMATTED)
+ fbuf_flush (u, u->mode);
+
+ sflush (u->s);
unlock_unit (u);
}
else
OSDN Git Service
