-/* Copyright (C) 2002-2003, 2005, 2006 Free Software Foundation, Inc.
+/* Copyright (C) 2002-2003, 2005, 2006, 2007 Free Software Foundation, Inc.
Contributed by Andy Vaught and Janne Blomqvist
This file is part of the GNU Fortran runtime library (libgfortran).
the Free Software Foundation, 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA. */
-#include "config.h"
-#include <string.h>
-#include "libgfortran.h"
#include "io.h"
+#include <string.h>
/* file_pos.c-- Implement the file positioning statements, i.e. BACKSPACE,
ENDFILE, and REWIND as well as the FLUSH statement. */
return;
io_error:
- generate_error (&fpp->common, ERROR_OS, NULL);
+ generate_error (&fpp->common, LIBERROR_OS, NULL);
}
/* unformatted_backspace(fpp) -- Move the file backwards for an unformatted
sequential file. We are guaranteed to be between records on entry and
- we have to shift to the previous record. */
+ we have to shift to the previous record. Loop over subrecords. */
static void
unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
GFC_INTEGER_4 m4;
GFC_INTEGER_8 m8;
int length, length_read;
+ int continued;
char *p;
if (compile_options.record_marker == 0)
- length = sizeof (gfc_offset);
+ length = sizeof (GFC_INTEGER_4);
else
length = compile_options.record_marker;
- length_read = length;
+ do
+ {
+ length_read = length;
- p = salloc_r_at (u->s, &length_read,
- file_position (u->s) - length);
- if (p == NULL || length_read != length)
- goto io_error;
+ p = salloc_r_at (u->s, &length_read,
+ file_position (u->s) - length);
+ if (p == NULL || length_read != length)
+ goto io_error;
- /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */
- if (u->flags.convert == CONVERT_NATIVE)
- {
- switch (compile_options.record_marker)
+ /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
+ if (u->flags.convert == GFC_CONVERT_NATIVE)
{
- case 0:
- memcpy (&m, p, sizeof(gfc_offset));
- break;
-
- case sizeof(GFC_INTEGER_4):
- memcpy (&m4, p, sizeof (m4));
- m = m4;
- break;
-
- case sizeof(GFC_INTEGER_8):
- memcpy (&m8, p, sizeof (m8));
- m = m8;
- break;
-
- default:
- runtime_error ("Illegal value for record marker");
- break;
+ switch (length)
+ {
+ case sizeof(GFC_INTEGER_4):
+ memcpy (&m4, p, sizeof (m4));
+ m = m4;
+ break;
+
+ case sizeof(GFC_INTEGER_8):
+ memcpy (&m8, p, sizeof (m8));
+ m = m8;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
}
- }
- else
- {
- switch (compile_options.record_marker)
+ else
{
- case 0:
- reverse_memcpy (&m, p, sizeof(gfc_offset));
- break;
-
- case sizeof(GFC_INTEGER_4):
- reverse_memcpy (&m4, p, sizeof (m4));
- m = m4;
- break;
-
- case sizeof(GFC_INTEGER_8):
- reverse_memcpy (&m8, p, sizeof (m8));
- m = m8;
- break;
-
- default:
- runtime_error ("Illegal value for record marker");
- break;
+ switch (length)
+ {
+ case sizeof(GFC_INTEGER_4):
+ reverse_memcpy (&m4, p, sizeof (m4));
+ m = m4;
+ break;
+
+ case sizeof(GFC_INTEGER_8):
+ reverse_memcpy (&m8, p, sizeof (m8));
+ m = m8;
+ break;
+
+ default:
+ runtime_error ("Illegal value for record marker");
+ break;
+ }
+
}
- }
+ continued = m < 0;
+ if (continued)
+ m = -m;
- if ((new = file_position (u->s) - m - 2*length) < 0)
- new = 0;
+ if ((new = file_position (u->s) - m - 2*length) < 0)
+ new = 0;
- if (sseek (u->s, new) == FAILURE)
- goto io_error;
+ if (sseek (u->s, new) == FAILURE)
+ goto io_error;
+ } while (continued);
u->last_record--;
return;
io_error:
- generate_error (&fpp->common, ERROR_OS, NULL);
+ generate_error (&fpp->common, LIBERROR_OS, NULL);
}
u = find_unit (fpp->common.unit);
if (u == NULL)
{
- generate_error (&fpp->common, ERROR_BAD_UNIT, NULL);
+ generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL);
goto done;
}
if (u->endfile == AFTER_ENDFILE)
{
u->endfile = AT_ENDFILE;
+ u->flags.position = POSITION_APPEND;
flush (u->s);
- struncate (u->s);
}
else
{
if (file_position (u->s) == 0)
- goto done; /* Common special case */
+ {
+ u->flags.position = POSITION_REWIND;
+ goto done; /* Common special case */
+ }
if (u->mode == WRITING)
{
else
unformatted_backspace (fpp, u);
+ update_position (u);
u->endfile = NO_ENDFILE;
u->current_record = 0;
u->bytes_left = 0;
flush (u->s);
struncate (u->s);
u->endfile = AFTER_ENDFILE;
+ update_position (u);
unlock_unit (u);
}
if (u != NULL)
{
if (u->flags.access == ACCESS_DIRECT)
- generate_error (&fpp->common, ERROR_BAD_OPTION,
+ generate_error (&fpp->common, LIBERROR_BAD_OPTION,
"Cannot REWIND a file opened for DIRECT access");
else
{
u->mode = READING;
u->last_record = 0;
- if (sseek (u->s, 0) == FAILURE)
- generate_error (&fpp->common, ERROR_OS, NULL);
- u->endfile = NO_ENDFILE;
+ if (file_position (u->s) != 0 && sseek (u->s, 0) == FAILURE)
+ generate_error (&fpp->common, LIBERROR_OS, NULL);
+
+ /* Handle special files like /dev/null differently. */
+ if (!is_special (u->s))
+ {
+ /* We are rewinding so we are not at the end. */
+ u->endfile = NO_ENDFILE;
+ }
+ else
+ {
+ /* Set this for compatibilty with g77 for /dev/null. */
+ if (file_length (u->s) == 0 && file_position (u->s) == 0)
+ u->endfile = AT_ENDFILE;
+ /* Future refinements on special files can go here. */
+ }
+
u->current_record = 0;
- u->bytes_left = 0;
+ u->strm_pos = 1;
u->read_bad = 0;
- test_endfile (u);
}
/* Update position for INQUIRE. */
u->flags.position = POSITION_REWIND;
}
else
/* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */
- generate_error (&fpp->common, ERROR_BAD_OPTION,
+ generate_error (&fpp->common, LIBERROR_BAD_OPTION,
"Specified UNIT in FLUSH is not connected");
library_end ();
OSDN Git Service
