diff options
| -rw-r--r-- | libgfortran/ChangeLog | 39 | ||||
| -rw-r--r-- | libgfortran/gfortran.map | 1 | ||||
| -rw-r--r-- | libgfortran/io/format.c | 24 | ||||
| -rw-r--r-- | libgfortran/io/io.h | 96 | ||||
| -rw-r--r-- | libgfortran/io/list_read.c | 39 | ||||
| -rw-r--r-- | libgfortran/io/open.c | 142 | ||||
| -rw-r--r-- | libgfortran/io/read.c | 12 | ||||
| -rw-r--r-- | libgfortran/io/transfer.c | 101 | ||||
| -rw-r--r-- | libgfortran/io/unit.c | 17 | ||||
| -rw-r--r-- | libgfortran/io/unix.c | 85 | ||||
| -rw-r--r-- | libgfortran/io/write.c | 29 | ||||
| -rw-r--r-- | libgfortran/io/write_float.def | 31 | ||||
| -rw-r--r-- | libgfortran/libgfortran.h | 8 |
13 files changed, 519 insertions, 105 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 11592e4..7c1a3b1 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,42 @@ +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 diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 61b0d44..2d05372 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -1037,6 +1037,7 @@ GFORTRAN_1.1 { _gfortran_erfc_scaled_r8; _gfortran_erfc_scaled_r10; _gfortran_erfc_scaled_r16; + _gfortran_st_wait; } GFORTRAN_1.0; F2C_1.0 { diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index 0f7a2e5..734b633 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -1,6 +1,7 @@ -/* 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). @@ -395,7 +396,6 @@ format_lex (format_data *fmt) unget_char (fmt); break; } - break; case 'G': @@ -415,7 +415,19 @@ format_lex (format_data *fmt) 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: @@ -550,6 +562,11 @@ parse_format_list (st_parameter_dt *dtp) 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: @@ -576,6 +593,7 @@ parse_format_list (st_parameter_dt *dtp) notify_std (&dtp->common, GFC_STD_GNU, "Extension: $ descriptor"); goto between_desc; + case FMT_T: case FMT_TL: case FMT_TR: diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 3e020ec..ddbd632 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -1,6 +1,7 @@ -/* 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). @@ -44,7 +45,6 @@ typedef enum } bt; - struct st_parameter_dt; typedef struct stream @@ -61,6 +61,9 @@ typedef struct stream } stream; +typedef enum +{ SYNC_BUFFERED, SYNC_UNBUFFERED, ASYNC } +io_mode; /* Macros for doing file I/O given a stream. */ @@ -205,6 +208,25 @@ typedef enum 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; @@ -212,6 +234,10 @@ typedef enum {READING, WRITING} unit_mode; +typedef enum +{ ASYNC_YES, ASYNC_NO, AYSYNC_UNSPECIFIED } +unit_async; + #define CHARACTER1(name) \ char * name; \ gfc_charlen_type name ## _len @@ -233,6 +259,11 @@ typedef struct CHARACTER1 (delim); CHARACTER2 (pad); CHARACTER1 (convert); + CHARACTER2 (decimal); + CHARACTER1 (encoding); + CHARACTER2 (round); + CHARACTER1 (sign); + CHARACTER2 (asynchronous); } st_parameter_open; @@ -275,6 +306,16 @@ st_parameter_filepos; #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 { @@ -299,6 +340,15 @@ 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; @@ -314,6 +364,15 @@ struct format_data; #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) @@ -327,6 +386,15 @@ typedef struct st_parameter_dt 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 @@ -341,7 +409,7 @@ typedef struct st_parameter_dt 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. */ @@ -354,6 +422,7 @@ typedef struct st_parameter_dt 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; @@ -422,6 +491,16 @@ extern char check_st_parameter_dt[sizeof (((st_parameter_dt *) 0)->u.pad) >= 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 @@ -436,8 +515,13 @@ typedef struct 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; @@ -504,7 +588,8 @@ typedef enum 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; @@ -748,6 +833,9 @@ internal_proto(next_record); 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); diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index d295431..ae2eb35 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1,6 +1,8 @@ -/* 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). @@ -52,12 +54,12 @@ Boston, MA 02110-1301, USA. */ 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. */ @@ -323,6 +325,13 @@ eat_separator (st_parameter_dt *dtp) 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; @@ -666,6 +675,7 @@ read_logical (st_parameter_dt *dtp, int length) unget_char (dtp, c); break; + case '.': c = tolower (next_char (dtp)); switch (c) @@ -1115,6 +1125,9 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) 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') @@ -1130,6 +1143,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) for (;;) { c = next_char (dtp); + if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA) + c = '.'; switch (c) { CASE_DIGITS: @@ -1299,7 +1314,8 @@ eol_1: 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: @@ -1353,6 +1369,8 @@ read_real (st_parameter_dt *dtp, int length) seen_dp = 0; c = next_char (dtp); + if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA) + c = '.'; switch (c) { CASE_DIGITS: @@ -1388,6 +1406,8 @@ read_real (st_parameter_dt *dtp, int length) for (;;) { c = next_char (dtp); + if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA) + c = '.'; switch (c) { CASE_DIGITS: @@ -1395,8 +1415,8 @@ read_real (st_parameter_dt *dtp, int length) break; case '.': - if (seen_dp) - goto bad_real; + if (seen_dp) + goto bad_real; seen_dp = 1; push_char (dtp, c); @@ -1420,7 +1440,7 @@ read_real (st_parameter_dt *dtp, int length) goto got_repeat; CASE_SEPARATORS: - if (c != '\n' && c != ',' && c != '\r') + if (c != '\n' && c != ',' && c != '\r' && c != ';') unget_char (dtp, c); goto done; @@ -1452,6 +1472,9 @@ read_real (st_parameter_dt *dtp, int length) 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') @@ -1474,6 +1497,8 @@ read_real (st_parameter_dt *dtp, int length) for (;;) { c = next_char (dtp); + if (c == ',' && dtp->u.p.decimal_status == DECIMAL_COMMA) + c = '.'; switch (c) { CASE_DIGITS: diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index 0a409ed..5259684 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -1,6 +1,7 @@ -/* 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). @@ -97,6 +98,39 @@ static const st_option pad_opt[] = { 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}, @@ -106,6 +140,12 @@ static const st_option convert_opt[] = { 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. @@ -179,6 +219,26 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) 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) @@ -190,6 +250,14 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) 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. */ @@ -289,6 +357,62 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) } } + 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, @@ -607,6 +731,22 @@ st_open (st_parameter_open *opp) 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"); diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index b5f16ac..bba3772 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -1,5 +1,6 @@ -/* 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). @@ -246,7 +247,8 @@ read_a (st_parameter_dt *dtp, const fnode *f, char *p, int length) 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) @@ -601,7 +603,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int 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; @@ -614,6 +616,10 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length) { switch (*p) { + case ',': + if (dtp->u.p.decimal_status == DECIMAL_COMMA && *p == ',') + *p = '.'; + /* Fall through */ case '.': if (seen_dp) goto bad_float; diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index dc80fc3..56e93f2 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -1,7 +1,8 @@ -/* 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). @@ -93,6 +94,26 @@ static const st_option advance_opt[] = { }; +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 @@ -910,7 +931,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, /* 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 (;;) @@ -923,7 +944,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, next_record (dtp, 0); } - consume_data_flag = 1 ; + consume_data_flag = 1; if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK) break; @@ -1162,7 +1183,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, 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"); @@ -1278,17 +1299,17 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, 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; @@ -1298,22 +1319,32 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, 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; @@ -1323,7 +1354,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, 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; @@ -1769,6 +1800,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) 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); @@ -1958,6 +1993,35 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) 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) { @@ -2023,11 +2087,6 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) 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; @@ -2926,6 +2985,14 @@ st_write_done (st_parameter_dt *dtp) 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. */ diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index a54061d..f1928e6 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -1,5 +1,6 @@ -/* 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). @@ -430,6 +431,7 @@ get_internal_unit (st_parameter_dt *dtp) iunit->maxrec=0; iunit->current_record=0; iunit->read_bad = 0; + iunit->endfile = NO_ENDFILE; /* Set flags for the internal unit. */ @@ -438,7 +440,9 @@ get_internal_unit (st_parameter_dt *dtp) 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. */ @@ -524,6 +528,9 @@ init_units (void) 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; @@ -547,6 +554,9 @@ init_units (void) 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; @@ -570,6 +580,9 @@ init_units (void) 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; diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index b6afe8d..3896f04 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -1,6 +1,7 @@ -/* 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). @@ -93,8 +94,6 @@ id_from_fd (const int fd) #endif - - #ifndef SSIZE_MAX #define SSIZE_MAX SHRT_MAX #endif @@ -153,7 +152,7 @@ typedef struct 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]; @@ -184,7 +183,7 @@ typedef struct 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; } @@ -238,15 +237,15 @@ move_pos_offset (stream* st, int pos_off) 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; } @@ -615,23 +614,23 @@ fd_alloc_w_at (unix_stream * s, int *len, gfc_offset where) || 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; } @@ -655,7 +654,7 @@ fd_sfree (unix_stream * s) { if (s->ndirty != 0 && (s->buffer != s->small_buffer || options.all_unbuffered || - s->unbuffered)) + s->method == SYNC_UNBUFFERED)) return fd_flush (s); return SUCCESS; @@ -777,7 +776,7 @@ fd_read (unix_stream * s, void * buf, size_t * nbytes) 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); @@ -825,7 +824,7 @@ fd_write (unix_stream * s, const void * buf, size_t * nbytes) 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); @@ -874,7 +873,7 @@ fd_close (unix_stream * s) 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); @@ -887,7 +886,9 @@ static void 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; @@ -1224,7 +1225,7 @@ tempfile (st_parameter_open *opp) 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 @@ -1335,11 +1336,11 @@ regular_file (st_parameter_open *opp, unit_flags *flags) 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; @@ -1347,9 +1348,9 @@ regular_file (st_parameter_open *opp, unit_flags *flags) if (fd >=0) { flags->action = ACTION_WRITE; - return fd; /* success */ + return fd; /* success */ } - return fd; /* failure */ + return fd; /* failure */ } @@ -1366,7 +1367,7 @@ open_external (st_parameter_open *opp, unit_flags *flags) { 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. */ @@ -1431,7 +1432,7 @@ output_stream (void) 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; } @@ -1450,7 +1451,7 @@ error_stream (void) 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; } @@ -2050,13 +2051,13 @@ stream_offset (stream *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 diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c index d1a3d7a..be3c0d7 100644 --- a/libgfortran/io/write.c +++ b/libgfortran/io/write.c @@ -1,6 +1,8 @@ -/* 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). @@ -361,7 +363,7 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, 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); @@ -395,13 +397,13 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source, 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; } @@ -729,11 +731,13 @@ write_real (st_parameter_dt *dtp, const char *source, int length) 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); @@ -869,6 +873,11 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, 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. */ @@ -1075,12 +1084,12 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, 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; diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def index 028fd27..090bd71 100644 --- a/libgfortran/io/write_float.def +++ b/libgfortran/io/write_float.def @@ -1,6 +1,7 @@ -/* 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). @@ -31,7 +32,7 @@ Boston, MA 02110-1301, USA. */ #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 @@ -40,21 +41,21 @@ sign_t; 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; } @@ -336,7 +337,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, /* 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); @@ -362,7 +363,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, /* 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. */ @@ -390,9 +391,9 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, } /* 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. */ @@ -421,7 +422,7 @@ output_float (st_parameter_dt *dtp, const fnode *f, char *buffer, size_t size, 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) diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index b5cad85..7d329ff 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -1,5 +1,6 @@ /* 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> @@ -507,6 +508,11 @@ st_parameter_common; #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 */ |