aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/io
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran/io')
-rw-r--r--libgfortran/io/backspace.c15
-rw-r--r--libgfortran/io/format.c1
-rw-r--r--libgfortran/io/inquire.c7
-rw-r--r--libgfortran/io/io.h7
-rw-r--r--libgfortran/io/list_read.c19
-rw-r--r--libgfortran/io/open.c5
-rw-r--r--libgfortran/io/transfer.c10
-rw-r--r--libgfortran/io/write.c39
8 files changed, 76 insertions, 27 deletions
diff --git a/libgfortran/io/backspace.c b/libgfortran/io/backspace.c
index f8ab01c3488..225f69cc45a 100644
--- a/libgfortran/io/backspace.c
+++ b/libgfortran/io/backspace.c
@@ -111,7 +111,7 @@ unformatted_backspace (void)
if (p == NULL)
goto io_error;
- new = file_position (current_unit->s) - *p - length;
+ new = file_position (current_unit->s) - *p - 2*length;
if (sseek (current_unit->s, new) == FAILURE)
goto io_error;
@@ -155,16 +155,23 @@ st_backspace (void)
u->endfile = AT_ENDFILE;
else
{
- if (u->current_record)
- next_record (1);
-
if (file_position (u->s) == 0)
goto done; /* Common special case */
+ if (u->mode == WRITING)
+ {
+ flush (u->s);
+ struncate (u->s);
+ u->mode = READING;
+ }
+
if (u->flags.form == FORM_FORMATTED)
formatted_backspace ();
else
unformatted_backspace ();
+
+ u->endfile = NO_ENDFILE;
+ u->current_record = 0;
}
done:
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index db5e0fe7372..f8d858af7a7 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -564,6 +564,7 @@ parse_format_list (void)
case FMT_COLON:
get_fnode (&head, &tail, FMT_COLON);
+ tail->repeat = 1;
goto optional_comma;
case FMT_SLASH:
diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 28c2f6afbc5..1f0fcac6530 100644
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -46,7 +46,12 @@ inquire_via_unit (gfc_unit * u)
const char *p;
if (ioparm.exist != NULL)
- *ioparm.exist = (u != NULL);
+ {
+ if (ioparm.unit >= 0)
+ *ioparm.exist = 1;
+ else
+ *ioparm.exist = 0;
+ }
if (ioparm.opened != NULL)
*ioparm.opened = (u != NULL);
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 694ca1d7ac5..05c4355ad00 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -245,10 +245,11 @@ typedef struct
unit_flags;
-/* The default value of record length is defined here. This value can
- be overriden by the OPEN statement or by an environment variable. */
+/* The default value of record length for preconnected units is defined
+ here. This value can be overriden by an environment variable.
+ Default value is 1 Gb. */
-#define DEFAULT_RECL 10000
+#define DEFAULT_RECL 1073741824
typedef struct gfc_unit
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index eecc11491e3..0a869b9a16e 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -66,12 +66,13 @@ static char value[20];
#define CASE_DIGITS case '0': case '1': case '2': case '3': case '4': \
case '5': case '6': case '7': case '8': case '9'
-#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t'
+#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t': \
+ case '\r'
/* This macro assumes that we're operating on a variable. */
#define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \
- || c == '\t')
+ || c == '\t' || c == '\r')
/* Maximum repeat count. Less than ten times the maximum signed int32. */
@@ -163,7 +164,7 @@ next_char (void)
c = *p;
done:
- at_eol = (c == '\n');
+ at_eol = (c == '\n' || c == '\r');
return c;
}
@@ -230,6 +231,7 @@ eat_separator (void)
break;
case '\n':
+ case '\r':
break;
case '!':
@@ -284,6 +286,7 @@ finish_separator (void)
break;
case '\n':
+ case '\r':
goto restart;
case '!':
@@ -1052,8 +1055,9 @@ read_real (int length)
goto got_repeat;
CASE_SEPARATORS:
- if (c != '\n' && c != ',')
- unget_char (c); /* Real number that is just a digit-string. */
+ if (c != '\n' && c != ',' && c != '\r')
+ unget_char (c);
+
goto done;
default:
@@ -1164,8 +1168,6 @@ read_real (int length)
break;
CASE_SEPARATORS:
- unget_char (c);
- eat_separator ();
goto done;
default:
@@ -1174,6 +1176,8 @@ read_real (int length)
}
done:
+ unget_char (c);
+ eat_separator ();
push_char ('\0');
if (convert_real (value, saved_string, length))
return;
@@ -1485,6 +1489,7 @@ namelist_read (void)
return;
case ' ':
case '\n':
+ case '\r':
case '\t':
break;
case ',':
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index eaeb5a298c0..82a862b7c47 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -358,7 +358,7 @@ new_unit (unit_flags * flags)
/* Unspecified recl ends up with a processor dependent value. */
- u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : DEFAULT_RECL;
+ u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : g.max_offset;
u->last_record = 0;
u->current_record = 0;
@@ -481,7 +481,10 @@ st_open (void)
flags.position = POSITION_ASIS;
if (ioparm.library_return != LIBRARY_OK)
+ {
+ library_end ();
return;
+ }
u = find_unit (ioparm.unit);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index a55936f9e6c..4d4832395d9 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -177,7 +177,7 @@ read_sf (int *length)
return NULL;
}
- if (readlen < 1 || *q == '\n')
+ if (readlen < 1 || *q == '\n' || *q == '\r')
{
/* ??? What is this for? */
if (current_unit->unit_number == options.stdin_unit)
@@ -386,7 +386,7 @@ write_constant_string (fnode * f)
for (; length > 0; length--)
{
c = *p++ = *q++;
- if (c == delimiter && c != 'H')
+ if (c == delimiter && c != 'H' && c != 'h')
q++; /* Skip the doubled delimiter. */
}
}
@@ -935,6 +935,12 @@ data_transfer_init (int read_flag)
current_unit = get_unit (read_flag);
if (current_unit == NULL)
{ /* Open the unit with some default flags. */
+ if (ioparm.unit < 0)
+ {
+ generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
+ library_end ();
+ return;
+ }
memset (&u_flags, '\0', sizeof (u_flags));
u_flags.access = ACCESS_SEQUENTIAL;
u_flags.action = ACTION_READWRITE;
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 403b9afe322..d97caec8bc7 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -286,6 +286,8 @@ output_float (fnode *f, double value, int len)
int nzero;
/* Number of digits after the decimal point. */
int nafter;
+ /* Number of zeros after the decimal point, whatever the precision. */
+ int nzero_real;
int leadzero;
int nblanks;
int i;
@@ -295,9 +297,12 @@ output_float (fnode *f, double value, int len)
w = f->u.real.w;
d = f->u.real.d;
+ nzero_real = -1;
+
+
/* We should always know the field width and precision. */
if (d < 0)
- internal_error ("Uspecified precision");
+ internal_error ("Unspecified precision");
/* Use sprintf to print the number in the format +D.DDDDe+ddd
For an N digit exponent, this gives us (32-6)-N digits after the
@@ -359,6 +364,7 @@ output_float (fnode *f, double value, int len)
if (nbefore < 0)
{
nzero = -nbefore;
+ nzero_real = nzero;
if (nzero > d)
nzero = d;
nafter = d - nzero;
@@ -375,7 +381,8 @@ output_float (fnode *f, double value, int len)
case FMT_E:
case FMT_D:
i = g.scale_factor;
- e -= i;
+ if (value != 0.0)
+ e -= i;
if (i < 0)
{
nbefore = 0;
@@ -395,7 +402,7 @@ output_float (fnode *f, double value, int len)
nafter = d;
}
- if (ft = FMT_E)
+ if (ft == FMT_E)
expchar = 'E';
else
expchar = 'D';
@@ -404,7 +411,8 @@ output_float (fnode *f, double value, int len)
case FMT_EN:
/* The exponent must be a multiple of three, with 1-3 digits before
the decimal point. */
- e--;
+ if (value != 0.0)
+ e--;
if (e >= 0)
nbefore = e % 3;
else
@@ -421,7 +429,8 @@ output_float (fnode *f, double value, int len)
break;
case FMT_ES:
- e--;
+ if (value != 0.0)
+ e--;
nbefore = 1;
nzero = 0;
nafter = d;
@@ -435,7 +444,17 @@ output_float (fnode *f, double value, int len)
/* Round the value. */
if (nbefore + nafter == 0)
- ndigits = 0;
+ {
+ ndigits = 0;
+ if (nzero_real == d && digits[0] >= '5')
+ {
+ /* We rounded to zero but shouldn't have */
+ nzero--;
+ nafter = 1;
+ digits[0] = '1';
+ ndigits = 1;
+ }
+ }
else if (nbefore + nafter < ndigits)
{
ndigits = nbefore + nafter;
@@ -518,7 +537,7 @@ output_float (fnode *f, double value, int len)
/* Pick a field size if none was specified. */
if (w <= 0)
- w = nbefore + nzero + nafter + 2;
+ w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1);
/* Create the ouput buffer. */
out = write_block (w);
@@ -655,7 +674,7 @@ static void
write_float (fnode *f, const char *source, int len)
{
double n;
- int nb =0, res;
+ int nb =0, res, save_scale_factor;
char * p, fin;
fnode *f2 = NULL;
@@ -704,8 +723,10 @@ write_float (fnode *f, const char *source, int len)
}
else
{
+ save_scale_factor = g.scale_factor;
f2 = calculate_G_format(f, n, len, &nb);
output_float (f2, n, len);
+ g.scale_factor = save_scale_factor;
if (f2 != NULL)
free_mem(f2);
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-26 11:13:53 +0000