+2008-04-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/25829 28655
+ * gfortran.map: Add new symbol, _gfortran_st_wait.
+ * libgfortran.h (st_paramter_common): Add new I/O parameters.
+ * open.c (st_option decimal_opt[], st_option encoding_opt[],
+ st_option round_opt[], st_option sign_opt[], st_option async_opt[]): New
+ parameter option arrays. (edit_modes): Add checks for new parameters.
+ (new_unit): Likewise. (st_open): Likewise.
+ * list_read.c (CASE_SEPERATORS): Add ';' as a valid separator.
+ (eat_separator): Handle deimal comma. (read_logical): Fix whitespace.
+ (parse_real): Handle decimal comma. (read_real): Handle decimal comma.
+ * read.c (read_a): Use decimal status flag to allow comma in place of a
+ decimal point. (read_f): Allow comma as acceptable character in float.
+ According to decimal flag, substitute a period for a comma.
+ (read_x): If decimal status flag is comma, disable the read_comma flag,
+ not allowing comma as a delimiter, an extension otherwise.
+ * io.h: (unit_decimal, unit_encoding, unit_round, unit_sign,
+ unit_async): New enumerators. Add all new I/O parameters.
+ * unix.c (unix_stream, int_stream): Add io_mode asychronous I/O control.
+ (move_pos_offset, fd_alloc_w_at): Fix some whitespace.
+ (fd_sfree): Use new enumerator. (fd_read): Likewise.
+ (fd_write): Likewise. (fd_close): Fix whitespace.
+ (fd_open): Use new enumertors. (tempfile, regular_file,
+ open_external): Fix whitespace. (output_stream, error_stream): Set
+ method. (stream_offset): Fix whitespace.
+ * transfer.c: (st_option decimal_opt[], sign_opt[], blank_opt[]): New
+ option arrays. (formatted_transfer_scalar): Set sf_read_comma flag
+ based on new decimal_status flag. (data_transfer_init): Initialize new
+ parameters. Add checks for decimal, sign, and blank. (st_wait): New stub.
+ * format.c: (format_lex): Add format specifiers DP, DC, and D.
+ (parse_format_list): Parse the new specifiers.
+ * write.c (write_decimal): Use new sign enumerators to set the sign.
+ (write_complex): Handle decimal comma and semi-colon separator.
+ (nml_write_obj): Likewise.
+ * write_float.def: Revise sign enumerators. (calculate_sign): Use new
+ sign enumerators. (output_float): Likewise. Use new decimal_status flag
+ to set the decimal character to a point or a comma.
+
2008-03-28 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/32972
_gfortran_erfc_scaled_r8;
_gfortran_erfc_scaled_r10;
_gfortran_erfc_scaled_r16;
+ _gfortran_st_wait;
} GFORTRAN_1.0;
F2C_1.0 {
-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
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).
unget_char (fmt);
break;
}
-
break;
case 'G':
break;
case 'D':
- token = FMT_D;
+ switch (next_char (fmt, 0))
+ {
+ case 'P':
+ token = FMT_DP;
+ break;
+ case 'C':
+ token = FMT_DC;
+ break;
+ default:
+ token = FMT_D;
+ unget_char (fmt);
+ break;
+ }
break;
case -1:
tail->repeat = 1;
goto optional_comma;
+ case FMT_DC:
+ case FMT_DP:
+ notify_std (&dtp->common, GFC_STD_F2003, "Fortran 2003: DC or DP "
+ "descriptor not allowed");
+ /* Fall through. */
case FMT_S:
case FMT_SS:
case FMT_SP:
notify_std (&dtp->common, GFC_STD_GNU, "Extension: $ descriptor");
goto between_desc;
+
case FMT_T:
case FMT_TL:
case FMT_TR:
-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
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).
}
bt;
-
struct st_parameter_dt;
typedef struct stream
}
stream;
+typedef enum
+{ SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC }
+io_mode;
/* Macros for doing file I/O given a stream. */
{ PAD_YES, PAD_NO, PAD_UNSPECIFIED }
unit_pad;
+typedef enum
+{ DECIMAL_POINT, DECIMAL_COMMA, DECIMAL_UNSPECIFIED }
+unit_decimal;
+
+typedef enum
+{ ENCODING_UTF8, ENCODING_DEFAULT, ENCODING_UNSPECIFIED }
+unit_encoding;
+
+typedef enum
+{ ROUND_UP, ROUND_DOWN, ROUND_ZERO, ROUND_NEAREST, ROUND_COMPATIBLE,
+ ROUND_PROCDEFINED, ROUND_UNSPECIFIED }
+unit_round;
+
+/* NOTE: unit_sign must correspond with the sign_status enumerator in
+ st_parameter_dt to not break the ABI. */
+typedef enum
+{ SIGN_PROCDEFINED, SIGN_SUPPRESS, SIGN_PLUS, SIGN_UNSPECIFIED }
+unit_sign;
+
typedef enum
{ ADVANCE_YES, ADVANCE_NO, ADVANCE_UNSPECIFIED }
unit_advance;
{READING, WRITING}
unit_mode;
+typedef enum
+{ ASYNC_YES, ASYNC_NO, AYSYNC_UNSPECIFIED }
+unit_async;
+
#define CHARACTER1(name) \
char * name; \
gfc_charlen_type name ## _len
CHARACTER1 (delim);
CHARACTER2 (pad);
CHARACTER1 (convert);
+ CHARACTER2 (decimal);
+ CHARACTER1 (encoding);
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
+ CHARACTER2 (asynchronous);
}
st_parameter_open;
#define IOPARM_INQUIRE_HAS_WRITE (1 << 28)
#define IOPARM_INQUIRE_HAS_READWRITE (1 << 29)
#define IOPARM_INQUIRE_HAS_CONVERT (1 << 30)
+#define IOPARM_INQUIRE_HAS_FLAGS2 (1 << 31)
+
+#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
+#define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1)
+#define IOPARM_INQUIRE_HAS_ENCODING (1 << 2)
+#define IOPARM_INQUIRE_HAS_PENDING (1 << 3)
+#define IOPARM_INQUIRE_HAS_ROUND (1 << 4)
+#define IOPARM_INQUIRE_HAS_SIGN (1 << 5)
+#define IOPARM_INQUIRE_HAS_SIZE (1 << 6)
+#define IOPARM_INQUIRE_HAS_ID (1 << 7)
typedef struct
{
CHARACTER1 (write);
CHARACTER2 (readwrite);
CHARACTER1 (convert);
+ GFC_INTEGER_4 flags2;
+ CHARACTER1 (asynchronous);
+ CHARACTER1 (decimal);
+ CHARACTER1 (encoding);
+ CHARACTER1 (pending);
+ CHARACTER1 (round);
+ CHARACTER1 (sign);
+ GFC_INTEGER_4 *size;
+ GFC_IO_INT id;
}
st_parameter_inquire;
#define IOPARM_DT_HAS_ADVANCE (1 << 13)
#define IOPARM_DT_HAS_INTERNAL_UNIT (1 << 14)
#define IOPARM_DT_HAS_NAMELIST_NAME (1 << 15)
+#define IOPARM_DT_HAS_ID (1 << 16)
+#define IOPARM_DT_HAS_POS (1 << 17)
+#define IOPARM_DT_HAS_ASYNCHRONOUS (1 << 18)
+#define IOPARM_DT_HAS_BLANK (1 << 19)
+#define IOPARM_DT_HAS_DECIMAL (1 << 20)
+#define IOPARM_DT_HAS_DELIM (1 << 21)
+#define IOPARM_DT_HAS_PAD (1 << 22)
+#define IOPARM_DT_HAS_ROUND (1 << 23)
+#define IOPARM_DT_HAS_SIGN (1 << 24)
/* Internal use bit. */
#define IOPARM_DT_IONML_SET (1 << 31)
CHARACTER2 (advance);
CHARACTER1 (internal_unit);
CHARACTER2 (namelist_name);
+ GFC_IO_INT *id;
+ GFC_IO_INT pos;
+ CHARACTER1 (asynchronous);
+ CHARACTER2 (blank);
+ CHARACTER1 (decimal);
+ CHARACTER2 (delim);
+ CHARACTER1 (pad);
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
/* Private part of the structure. The compiler just needs
to reserve enough space. */
union
int item_count;
unit_mode mode;
unit_blank blank_status;
- enum {SIGN_S, SIGN_SS, SIGN_SP} sign_status;
+ enum { SIGN_S, SIGN_SS, SIGN_SP } sign_status;
int scale_factor;
int max_pos; /* Maximum righthand column written to. */
/* Number of skips + spaces to be done for T and X-editing. */
2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
int sf_seen_eor;
unit_advance advance_status;
+ unit_decimal decimal_status;
unsigned reversion_flag : 1; /* Format reversion has occurred. */
unsigned first_item : 1;
>= sizeof (((st_parameter_dt *) 0)->u.p)
? 1 : -1];
+#define IOPARM_WAIT_HAS_ID (1 << 7)
+
+typedef struct
+{
+ st_parameter_common common;
+ CHARACTER1 (id);
+}
+st_parameter_wait;
+
+
#undef CHARACTER1
#undef CHARACTER2
unit_position position;
unit_status status;
unit_pad pad;
+ unit_decimal decimal;
+ unit_encoding encoding;
+ unit_round round;
+ unit_sign sign;
unit_convert convert;
int has_recl;
+ unit_async async;
}
unit_flags;
FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
- FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END
+ FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC,
+ FMT_DP
}
format_token;
extern void reverse_memcpy (void *, const void *, size_t);
internal_proto (reverse_memcpy);
+extern void st_wait (st_parameter_wait *);
+export_proto(st_wait);
+
/* read.c */
extern void set_integer (void *, GFC_INTEGER_LARGEST, int);
-/* Copyright (C) 2002, 2003, 2004, 2005, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
Namelist input contributed by Paul Thomas
+ F2003 I/O support contributed by Jerry DeLisle
This file is part of the GNU Fortran 95 runtime library (libgfortran).
case '5': case '6': case '7': case '8': case '9'
#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': case '\t': \
- case '\r'
+ case '\r': case ';'
/* This macro assumes that we're operating on a variable. */
#define is_separator(c) (c == '/' || c == ',' || c == '\n' || c == ' ' \
- || c == '\t' || c == '\r')
+ || c == '\t' || c == '\r' || c == ';')
/* Maximum repeat count. Less than ten times the maximum signed int32. */
switch (c)
{
case ',':
+ if (dtp->u.p.decimal_status == DECIMAL_COMMA)
+ {
+ unget_char (dtp, c);
+ break;
+ }
+ /* Fall through. */
+ case ';':
dtp->u.p.comma_flag = 1;
eat_spaces (dtp);
break;
unget_char (dtp, c);
break;
+
case '.':
c = tolower (next_char (dtp));
switch (c)
c = next_char (dtp);
}
+ if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+ c = '.';
+
if (!isdigit (c) && c != '.')
{
if (c == 'i' || c == 'I' || c == 'n' || c == 'N')
for (;;)
{
c = next_char (dtp);
+ if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+ c = '.';
switch (c)
{
CASE_DIGITS:
else
unget_char (dtp, c);
- if (next_char (dtp) != ',')
+ if (next_char (dtp)
+ != (dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';'))
goto bad_complex;
eol_2:
seen_dp = 0;
c = next_char (dtp);
+ if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+ c = '.';
switch (c)
{
CASE_DIGITS:
for (;;)
{
c = next_char (dtp);
+ if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+ c = '.';
switch (c)
{
CASE_DIGITS:
break;
case '.':
- if (seen_dp)
- goto bad_real;
+ if (seen_dp)
+ goto bad_real;
seen_dp = 1;
push_char (dtp, c);
goto got_repeat;
CASE_SEPARATORS:
- if (c != '\n' && c != ',' && c != '\r')
+ if (c != '\n' && c != ',' && c != '\r' && c != ';')
unget_char (dtp, c);
goto done;
c = next_char (dtp);
}
+ if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+ c = '.';
+
if (!isdigit (c) && c != '.')
{
if (c == 'i' || c == 'I' || c == 'n' || c == 'N')
for (;;)
{
c = next_char (dtp);
+ if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA)
+ c = '.';
switch (c)
{
CASE_DIGITS:
-/* Copyright (C) 2002, 2003, 2004, 2005, 2007
+/* Copyright (C) 2002, 2003, 2004, 2005, 2007, 2008
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).
{ NULL, 0}
};
+static const st_option decimal_opt[] =
+{
+ { "point", DECIMAL_POINT},
+ { "comma", DECIMAL_COMMA},
+ { NULL, 0}
+};
+
+static const st_option encoding_opt[] =
+{
+ { "utf-8", ENCODING_UTF8},
+ { "default", ENCODING_DEFAULT},
+ { NULL, 0}
+};
+
+static const st_option round_opt[] =
+{
+ { "up", ROUND_UP},
+ { "down", ROUND_DOWN},
+ { "zero", ROUND_ZERO},
+ { "nearest", ROUND_NEAREST},
+ { "compatible", ROUND_COMPATIBLE},
+ { "processor_defined", ROUND_PROCDEFINED},
+ { NULL, 0}
+};
+
+static const st_option sign_opt[] =
+{
+ { "plus", SIGN_PLUS},
+ { "suppress", SIGN_SUPPRESS},
+ { "processor_defined", SIGN_PROCDEFINED},
+ { NULL, 0}
+};
+
static const st_option convert_opt[] =
{
{ "native", GFC_CONVERT_NATIVE},
{ NULL, 0}
};
+static const st_option async_opt[] =
+{
+ { "yes", ASYNC_YES},
+ { "no", ASYNC_NO},
+ { NULL, 0}
+};
/* Given a unit, test to see if the file is positioned at the terminal
point, and if so, change state from NO_ENDFILE flag to AT_ENDFILE.
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"PAD parameter conflicts with UNFORMATTED form in "
"OPEN statement");
+
+ if (flags->decimal != DECIMAL_UNSPECIFIED)
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "DECIMAL parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
+
+ if (flags->encoding != ENCODING_UNSPECIFIED)
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "ENCODING parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
+
+ if (flags->round != ROUND_UNSPECIFIED)
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "ROUND parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
+
+ if (flags->sign != SIGN_UNSPECIFIED)
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "SIGN parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
}
if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
u->flags.delim = flags->delim;
if (flags->pad != PAD_UNSPECIFIED)
u->flags.pad = flags->pad;
+ if (flags->decimal != DECIMAL_UNSPECIFIED)
+ u->flags.decimal = flags->decimal;
+ if (flags->encoding != ENCODING_UNSPECIFIED)
+ u->flags.encoding = flags->encoding;
+ if (flags->round != ROUND_UNSPECIFIED)
+ u->flags.round = flags->round;
+ if (flags->sign != SIGN_UNSPECIFIED)
+ u->flags.sign = flags->sign;
}
/* Reposition the file if necessary. */
}
}
+ if (flags->decimal == DECIMAL_UNSPECIFIED)
+ flags->decimal = DECIMAL_POINT;
+ else
+ {
+ if (flags->form == FORM_UNFORMATTED)
+ {
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "DECIMAL parameter conflicts with UNFORMATTED form "
+ "in OPEN statement");
+ goto fail;
+ }
+ }
+
+ if (flags->encoding == ENCODING_UNSPECIFIED)
+ flags->encoding = ENCODING_DEFAULT;
+ else
+ {
+ if (flags->form == FORM_UNFORMATTED)
+ {
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "ENCODING parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
+ goto fail;
+ }
+ }
+
+ /* NB: the value for ROUND when it's not specified by the user does not
+ have to be PROCESSOR_DEFINED; the standard says that it is
+ processor dependent, and requires that it is one of the
+ possible value (see F2003, 9.4.5.13). */
+ if (flags->round == ROUND_UNSPECIFIED)
+ flags->round = ROUND_PROCDEFINED;
+ else
+ {
+ if (flags->form == FORM_UNFORMATTED)
+ {
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "ROUND parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
+ goto fail;
+ }
+ }
+
+ if (flags->sign == SIGN_UNSPECIFIED)
+ flags->sign = SIGN_PROCDEFINED;
+ else
+ {
+ if (flags->form == FORM_UNFORMATTED)
+ {
+ generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+ "SIGN parameter conflicts with UNFORMATTED form in "
+ "OPEN statement");
+ goto fail;
+ }
+ }
+
if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
find_option (&opp->common, opp->pad, opp->pad_len,
pad_opt, "Bad PAD parameter in OPEN statement");
+ flags.decimal = !(cf & IOPARM_OPEN_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
+ find_option (&opp->common, opp->decimal, opp->decimal_len,
+ decimal_opt, "Bad DECIMAL parameter in OPEN statement");
+
+ flags.encoding = !(cf & IOPARM_OPEN_HAS_ENCODING) ? ENCODING_UNSPECIFIED :
+ find_option (&opp->common, opp->encoding, opp->encoding_len,
+ encoding_opt, "Bad ENCODING parameter in OPEN statement");
+
+ flags.round = !(cf & IOPARM_OPEN_HAS_ROUND) ? ROUND_UNSPECIFIED :
+ find_option (&opp->common, opp->round, opp->round_len,
+ round_opt, "Bad ROUND parameter in OPEN statement");
+
+ flags.sign = !(cf & IOPARM_OPEN_HAS_SIGN) ? SIGN_UNSPECIFIED :
+ find_option (&opp->common, opp->sign, opp->sign_len,
+ sign_opt, "Bad SIGN parameter in OPEN statement");
+
flags.form = !(cf & IOPARM_OPEN_HAS_FORM) ? FORM_UNSPECIFIED :
find_option (&opp->common, opp->form, opp->form_len,
form_opt, "Bad FORM parameter in OPEN statement");
-/* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2005, 2007, 2008 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).
dtp->u.p.sf_read_comma = 0;
source = read_block (dtp, &w);
- dtp->u.p.sf_read_comma = 1;
+ dtp->u.p.sf_read_comma =
+ dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
if (source == NULL)
return;
if (w > length)
/* A digit, a '.' or a exponent character ('e', 'E', 'd' or 'D')
is required at this point */
- if (!isdigit (*p) && *p != '.' && *p != 'd' && *p != 'D'
+ if (!isdigit (*p) && *p != '.' && *p != ',' && *p != 'd' && *p != 'D'
&& *p != 'e' && *p != 'E')
goto bad_float;
{
switch (*p)
{
+ case ',':
+ if (dtp->u.p.decimal_status == DECIMAL_COMMA && *p == ',')
+ *p = '.';
+ /* Fall through */
case '.':
if (seen_dp)
goto bad_float;
-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
Free Software Foundation, Inc.
Contributed by Andy Vaught
Namelist transfer functions contributed by Paul Thomas
+ F2003 I/O support contributed by Jerry DeLisle
This file is part of the GNU Fortran 95 runtime library (libgfortran).
};
+static const st_option decimal_opt[] = {
+ {"point", DECIMAL_POINT},
+ {"comma", DECIMAL_COMMA},
+ {NULL, 0}
+};
+
+
+static const st_option sign_opt[] = {
+ {"plus", SIGN_SP},
+ {"suppress", SIGN_SS},
+ {"processor_defined", SIGN_S},
+ {NULL, 0}
+};
+
+static const st_option blank_opt[] = {
+ {"null", BLANK_NULL},
+ {"zero", BLANK_ZERO},
+ {NULL, 0}
+};
+
typedef enum
{ FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL,
FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM
/* Set this flag so that commas in reads cause the read to complete before
the entire field has been read. The next read field will start right after
the comma in the stream. (Set to 0 for character reads). */
- dtp->u.p.sf_read_comma = 1;
+ dtp->u.p.sf_read_comma = dtp->u.p.decimal_status == DECIMAL_COMMA ? 0 : 1;
dtp->u.p.line_buffer = scratch;
for (;;)
next_record (dtp, 0);
}
- consume_data_flag = 1 ;
+ consume_data_flag = 1;
if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
break;
break;
case FMT_STRING:
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
if (dtp->u.p.mode == READING)
{
format_error (dtp, f, "Constant string in input format");
break;
case FMT_S:
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
dtp->u.p.sign_status = SIGN_S;
break;
case FMT_SS:
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
dtp->u.p.sign_status = SIGN_SS;
break;
case FMT_SP:
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
dtp->u.p.sign_status = SIGN_SP;
break;
break;
case FMT_BZ:
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
dtp->u.p.blank_status = BLANK_ZERO;
break;
+ case FMT_DC:
+ consume_data_flag = 0;
+ dtp->u.p.decimal_status = DECIMAL_COMMA;
+ break;
+
+ case FMT_DP:
+ consume_data_flag = 0;
+ dtp->u.p.decimal_status = DECIMAL_POINT;
+ break;
+
case FMT_P:
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
dtp->u.p.scale_factor = f->u.k;
break;
case FMT_DOLLAR:
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
dtp->u.p.seen_dollar = 1;
break;
case FMT_SLASH:
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
dtp->u.p.skips = dtp->u.p.pending_spaces = 0;
next_record (dtp, 0);
break;
particular preventing another / descriptor from being
processed) unless there is another data item to be
transferred. */
- consume_data_flag = 0 ;
+ consume_data_flag = 0;
if (n == 0)
return;
break;
u_flags.delim = DELIM_UNSPECIFIED;
u_flags.blank = BLANK_UNSPECIFIED;
u_flags.pad = PAD_UNSPECIFIED;
+ u_flags.decimal = DECIMAL_UNSPECIFIED;
+ u_flags.encoding = ENCODING_UNSPECIFIED;
+ u_flags.round = ROUND_UNSPECIFIED;
+ u_flags.sign = SIGN_UNSPECIFIED;
u_flags.status = STATUS_UNKNOWN;
conv = get_unformatted_convert (dtp->common.unit);
if (dtp->u.p.advance_status == ADVANCE_UNSPECIFIED)
dtp->u.p.advance_status = ADVANCE_YES;
+ /* Check the decimal mode. */
+
+ dtp->u.p.decimal_status
+ = !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
+ find_option (&dtp->common, dtp->decimal, dtp->decimal_len, decimal_opt,
+ "Bad DECIMAL parameter in data transfer statement");
+
+ if (dtp->u.p.decimal_status == DECIMAL_UNSPECIFIED)
+ dtp->u.p.decimal_status = dtp->u.p.current_unit->flags.decimal;
+
+ /* Check the sign mode. */
+ dtp->u.p.sign_status
+ = !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED :
+ find_option (&dtp->common, dtp->sign, dtp->sign_len, sign_opt,
+ "Bad SIGN parameter in data transfer statement");
+
+ if (dtp->u.p.sign_status == SIGN_UNSPECIFIED)
+ dtp->u.p.sign_status = dtp->u.p.current_unit->flags.sign;
+
+ /* Check the blank mode. */
+ dtp->u.p.blank_status
+ = !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED :
+ find_option (&dtp->common, dtp->blank, dtp->blank_len, blank_opt,
+ "Bad BLANK parameter in data transfer statement");
+
+ if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
+ dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank;
+
+
/* Sanity checks on the record number. */
if ((cf & IOPARM_DT_HAS_REC) != 0)
{
dtp->u.p.current_unit->mode = dtp->u.p.mode;
- /* Set the initial value of flags. */
-
- dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank;
- dtp->u.p.sign_status = SIGN_S;
-
/* Set the maximum position reached from the previous I/O operation. This
could be greater than zero from a previous non-advancing write. */
dtp->u.p.max_pos = dtp->u.p.current_unit->saved_pos;
library_end ();
}
+
+/* F2003: This is a stub for the runtime portion of the WAIT statement. */
+void
+st_wait (st_parameter_wait *wtp __attribute__((unused)))
+{
+}
+
+
/* Receives the scalar information for namelist objects and stores it
in a linked list of namelist_info types. */
-/* Copyright (C) 2002, 2003, 2005, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2005, 2007, 2008 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).
iunit->maxrec=0;
iunit->current_record=0;
iunit->read_bad = 0;
+ iunit->endfile = NO_ENDFILE;
/* Set flags for the internal unit. */
iunit->flags.form = FORM_FORMATTED;
iunit->flags.pad = PAD_YES;
iunit->flags.status = STATUS_UNSPECIFIED;
- iunit->endfile = NO_ENDFILE;
+ iunit->flags.sign = SIGN_SUPPRESS;
+ iunit->flags.decimal = DECIMAL_POINT;
+ iunit->flags.encoding = ENCODING_DEFAULT;
/* Initialize the data transfer parameters. */
u->flags.blank = BLANK_NULL;
u->flags.pad = PAD_YES;
u->flags.position = POSITION_ASIS;
+ u->flags.sign = SIGN_SUPPRESS;
+ u->flags.decimal = DECIMAL_POINT;
+ u->flags.encoding = ENCODING_DEFAULT;
u->recl = options.default_recl;
u->endfile = NO_ENDFILE;
u->flags.status = STATUS_OLD;
u->flags.blank = BLANK_NULL;
u->flags.position = POSITION_ASIS;
+ u->flags.sign = SIGN_SUPPRESS;
+ u->flags.decimal = DECIMAL_POINT;
+ u->flags.encoding = ENCODING_DEFAULT;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
u->flags.status = STATUS_OLD;
u->flags.blank = BLANK_NULL;
u->flags.position = POSITION_ASIS;
+ u->flags.sign = SIGN_SUPPRESS;
+ u->flags.decimal = DECIMAL_POINT;
+ u->flags.encoding = ENCODING_DEFAULT;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
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).
#endif
-
-
#ifndef SSIZE_MAX
#define SSIZE_MAX SHRT_MAX
#endif
int special_file; /* =1 if the fd refers to a special file */
- int unbuffered; /* =1 if the stream is not buffered */
+ io_mode method; /* Method of stream I/O being used */
char *buffer;
char small_buffer[BUFFER_SIZE];
int special_file; /* =1 if the fd refers to a special file */
- int unbuffered; /* =1 if the stream is not buffered */
+ io_mode method; /* Method of stream I/O being used */
char *buffer;
}
str->logical_offset += pos_off;
if (str->dirty_offset + str->ndirty > str->logical_offset)
- {
- if (str->ndirty + pos_off > 0)
- str->ndirty += pos_off;
- else
- {
- str->dirty_offset += pos_off + pos_off;
- str->ndirty = 0;
- }
- }
+ {
+ if (str->ndirty + pos_off > 0)
+ str->ndirty += pos_off;
+ else
+ {
+ str->dirty_offset += pos_off + pos_off;
+ str->ndirty = 0;
+ }
+ }
return pos_off;
}
|| where > s->dirty_offset + s->ndirty
|| s->dirty_offset > where + *len)
{ /* Discontiguous blocks, start with a clean buffer. */
- /* Flush the buffer. */
- if (s->ndirty != 0)
- fd_flush (s);
- s->dirty_offset = where;
- s->ndirty = *len;
+ /* Flush the buffer. */
+ if (s->ndirty != 0)
+ fd_flush (s);
+ s->dirty_offset = where;
+ s->ndirty = *len;
}
else
{
gfc_offset start; /* Merge with the existing data. */
if (where < s->dirty_offset)
- start = where;
+ start = where;
else
- start = s->dirty_offset;
+ start = s->dirty_offset;
if (where + *len > s->dirty_offset + s->ndirty)
- s->ndirty = where + *len - start;
+ s->ndirty = where + *len - start;
else
- s->ndirty = s->dirty_offset + s->ndirty - start;
+ s->ndirty = s->dirty_offset + s->ndirty - start;
s->dirty_offset = start;
}
{
if (s->ndirty != 0 &&
(s->buffer != s->small_buffer || options.all_unbuffered ||
- s->unbuffered))
+ s->method == SYNC_UNBUFFERED))
return fd_flush (s);
return SUCCESS;
void *p;
int tmp, status;
- if (*nbytes < BUFFER_SIZE && !s->unbuffered)
+ if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED)
{
tmp = *nbytes;
p = fd_alloc_r_at (s, &tmp, -1);
void *p;
int tmp, status;
- if (*nbytes < BUFFER_SIZE && !s->unbuffered)
+ if (*nbytes < BUFFER_SIZE && s->method == SYNC_BUFFERED)
{
tmp = *nbytes;
p = fd_alloc_w_at (s, &tmp, -1);
if (s->fd != STDOUT_FILENO && s->fd != STDERR_FILENO && s->fd != STDIN_FILENO)
{
if (close (s->fd) < 0)
- return FAILURE;
+ return FAILURE;
}
free_mem (s);
fd_open (unix_stream * s)
{
if (isatty (s->fd))
- s->unbuffered = 1;
+ s->method = SYNC_UNBUFFERED;
+ else
+ s->method = SYNC_BUFFERED;
s->st.alloc_r_at = (void *) fd_alloc_r_at;
s->st.alloc_w_at = (void *) fd_alloc_w_at;
do
#if defined(HAVE_CRLF) && defined(O_BINARY)
fd = open (template, O_RDWR | O_CREAT | O_EXCL | O_BINARY,
- S_IREAD | S_IWRITE);
+ S_IREAD | S_IWRITE);
#else
fd = open (template, O_RDWR | O_CREAT | O_EXCL, S_IREAD | S_IWRITE);
#endif
if (fd >=0)
{
flags->action = ACTION_READ;
- return fd; /* success */
+ return fd; /* success */
}
if (errno != EACCES)
- return fd; /* failure */
+ return fd; /* failure */
/* retry for write-only access */
rwflag = O_WRONLY;
if (fd >=0)
{
flags->action = ACTION_WRITE;
- return fd; /* success */
+ return fd; /* success */
}
- return fd; /* failure */
+ return fd; /* failure */
}
{
fd = tempfile (opp);
if (flags->action == ACTION_UNSPECIFIED)
- flags->action = ACTION_READWRITE;
+ flags->action = ACTION_READWRITE;
#if HAVE_UNLINK_OPEN_FILE
/* We can unlink scratch files now and it will go away when closed. */
s = fd_to_stream (STDOUT_FILENO, PROT_WRITE);
if (options.unbuffered_preconnected)
- ((unix_stream *) s)->unbuffered = 1;
+ ((unix_stream *) s)->method = SYNC_UNBUFFERED;
return s;
}
s = fd_to_stream (STDERR_FILENO, PROT_WRITE);
if (options.unbuffered_preconnected)
- ((unix_stream *) s)->unbuffered = 1;
+ ((unix_stream *) s)->method = SYNC_UNBUFFERED;
return s;
}
the solution used by f2c. Each record contains a pair of length
markers:
- Length of record n in bytes
- Data of record n
- Length of record n in bytes
+ Length of record n in bytes
+ Data of record n
+ Length of record n in bytes
- Length of record n+1 in bytes
- Data of record n+1
- Length of record n+1 in bytes
+ Length of record n+1 in bytes
+ Data of record n+1
+ Length of record n+1 in bytes
The length is stored at the end of a record to allow backspacing to the
previous record. Between data transfer statements, the file pointer
-/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
Namelist output contributed by Paul Thomas
+ F2003 I/O support contributed by Jerry DeLisle
This file is part of the GNU Fortran 95 runtime library (libgfortran).
if (n < 0)
n = -n;
- nsign = sign == SIGN_NONE ? 0 : 1;
+ nsign = sign == S_NONE ? 0 : 1;
q = conv (n, itoa_buf, sizeof (itoa_buf));
digits = strlen (q);
switch (sign)
{
- case SIGN_PLUS:
+ case S_PLUS:
*p++ = '+';
break;
- case SIGN_MINUS:
+ case S_MINUS:
*p++ = '-';
break;
- case SIGN_NONE:
+ case S_NONE:
break;
}
static void
write_complex (st_parameter_dt *dtp, const char *source, int kind, size_t size)
{
+ char semi_comma = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
+
if (write_char (dtp, '('))
return;
write_real (dtp, source, kind);
- if (write_char (dtp, ','))
+ if (write_char (dtp, semi_comma))
return;
write_real (dtp, source + size / 2, kind);
size_t base_var_name_len;
size_t tot_len;
unit_delim tmp_delim;
+
+ /* Set the character to be used to separate values
+ to a comma or semi-colon. */
+
+ char semi_comma = dtp->u.p.decimal_status == DECIMAL_POINT ? ',' : ';';
/* Write namelist variable names in upper case. If a derived type,
nothing is output. If a component, base and base_name are set. */
internal_error (&dtp->common, "Bad type for namelist write");
}
- /* Reset the leading blank suppression, write a comma and, if 5
- values have been output, write a newline and advance to column
- 2. Reset the repeat counter. */
+ /* Reset the leading blank suppression, write a comma (or semi-colon)
+ and, if 5 values have been output, write a newline and advance
+ to column 2. Reset the repeat counter. */
dtp->u.p.no_leading_blank = 0;
- write_character (dtp, ",", 1);
+ write_character (dtp, &semi_comma, 1);
if (num > 5)
{
num = 0;
-/* Copyright (C) 2007 Free Software Foundation, Inc.
+/* Copyright (C) 2007, 2008 Free Software Foundation, Inc.
Contributed by Andy Vaught
Write float code factoring to this file by Jerry DeLisle
+ F2003 I/O support contributed by Jerry DeLisle
This file is part of the GNU Fortran 95 runtime library (libgfortran).
#include "config.h"
typedef enum
-{ SIGN_NONE, SIGN_MINUS, SIGN_PLUS }
+{ S_NONE, S_MINUS, S_PLUS }
sign_t;
/* Given a flag that indicates if a value is negative or not, return a
static sign_t
calculate_sign (st_parameter_dt *dtp, int negative_flag)
{
- sign_t s = SIGN_NONE;
+ sign_t s = S_NONE;
if (negative_flag)
- s = SIGN_MINUS;
+ s = S_MINUS;
else
switch (dtp->u.p.sign_status)
{
- case SIGN_SP:
- s = SIGN_PLUS;
+ case SIGN_SP: /* Show sign. */
+ s = S_PLUS;
break;
- case SIGN_SS:
- s = SIGN_NONE;
+ case SIGN_SS: /* Suppress sign. */
+ s = S_NONE;
break;
- case SIGN_S:
- s = options.optional_plus ? SIGN_PLUS : SIGN_NONE;
+ case SIGN_S: /* Processor defined. */
+ s = options.optional_plus ? S_PLUS : S_NONE;
break;
}
/* Pick a field size if none was specified. */
if (w <= 0)
- w = nbefore + nzero + nafter + (sign != SIGN_NONE ? 2 : 1);
+ w = nbefore + nzero + nafter + (sign != S_NONE ? 2 : 1);
/* Create the ouput buffer. */
out = write_block (dtp, w);
/* Work out how much padding is needed. */
nblanks = w - (nbefore + nzero + nafter + edigits + 1);
- if (sign != SIGN_NONE)
+ if (sign != S_NONE)
nblanks--;
/* Check the value fits in the specified field width. */
}
/* Output the initial sign (if any). */
- if (sign == SIGN_PLUS)
+ if (sign == S_PLUS)
*(out++) = '+';
- else if (sign == SIGN_MINUS)
+ else if (sign == S_MINUS)
*(out++) = '-';
/* Output an optional leading zero. */
out += nbefore;
}
/* Output the decimal point. */
- *(out++) = '.';
+ *(out++) = dtp->u.p.decimal_status == DECIMAL_POINT ? '.' : ',';
/* Output leading zeros after the decimal point. */
if (nzero > 0)
/* Common declarations for all of libgfortran.
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>, and
Andy Vaught <andy@xena.eas.asu.edu>
#define IOPARM_OPEN_HAS_DELIM (1 << 15)
#define IOPARM_OPEN_HAS_PAD (1 << 16)
#define IOPARM_OPEN_HAS_CONVERT (1 << 17)
+#define IOPARM_OPEN_HAS_DECIMAL (1 << 18)
+#define IOPARM_OPEN_HAS_ENCODING (1 << 19)
+#define IOPARM_OPEN_HAS_ROUND (1 << 20)
+#define IOPARM_OPEN_HAS_SIGN (1 << 21)
+#define IOPARM_OPEN_HAS_ASYNCHRONOUS (1 << 22)
/* library start function and end macro. These can be expanded if needed
in the future. cmp is st_parameter_common *cmp */
projects / gcc.git / commitdiff