+2008-04-07 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/25829 28655
+ * io/open.c (edit_modes): Set flags.async. (new_unit) Set flags.async
+ and flags.status. (st_open): Initialize flags.async.
+ * io/list_read.c (read_charactor): Use delim_status instead of
+ flags.delim.
+ * io/read.c (read_x): Use pad_status instead of flags.pad.
+ * io/inquire.c (inquire_via_unit): Add new checks.
+ (inquire_via_filename): Likewise.
+ * io/io.h (st_parameter_inquire): Add new flags.
+ (st_parameter_dt): Likewise.
+ * io/unit.c (get_internal_unit): Set flags.async. (init_units): Set
+ flags.async.
+ * io/transfer.c: Add delim and pad option arrays. (read_sf): Use
+ pad_status instead of flags.pad. (read_block): Likewise.
+ (data_transfer_init): Set flags.async and add checks.
+ * io/write.c (write_character): Use delim_status.
+ (list_formatted_write_scalar): Likewise. (nml_write_obj): Likewise.
+ (namelist_write): Likewise.
+
2008-04-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/25829 28655
{
const char *p;
GFC_INTEGER_4 cf = iqp->common.flags;
+ GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
{
if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
{
- if (u == NULL)
+ if (u == NULL || u->flags.form != FORM_FORMATTED)
p = undefined;
else
switch (u->flags.blank)
cf_strcpy (iqp->blank, iqp->blank_len, p);
}
+ if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
+ {
+ if (u == NULL || u->flags.form != FORM_FORMATTED)
+ p = undefined;
+ else
+ switch (u->flags.pad)
+ {
+ case PAD_YES:
+ p = "YES";
+ break;
+ case PAD_NO:
+ p = "NO";
+ break;
+ default:
+ internal_error (&iqp->common, "inquire_via_unit(): Bad pad");
+ }
+
+ cf_strcpy (iqp->pad, iqp->pad_len, p);
+ }
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
+ *iqp->pending = 0;
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_ID) != 0)
+ *iqp->id = 0;
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+ {
+ if (u == NULL || u->flags.form != FORM_FORMATTED)
+ p = undefined;
+ else
+ switch (u->flags.encoding)
+ {
+ case ENCODING_DEFAULT:
+ p = "UNKNOWN";
+ break;
+ /* TODO: Enable UTF-8 case here when implemented.
+ case ENCODING_UTF8:
+ p = "UTF-8";
+ break; */
+ default:
+ internal_error (&iqp->common, "inquire_via_unit(): Bad encoding");
+ }
+
+ cf_strcpy (iqp->encoding, iqp->encoding_len, p);
+ }
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
+ {
+ if (u == NULL || u->flags.form != FORM_FORMATTED)
+ p = undefined;
+ else
+ switch (u->flags.decimal)
+ {
+ case DECIMAL_POINT:
+ p = "POINT";
+ break;
+ case DECIMAL_COMMA:
+ p = "COMMA";
+ break;
+ default:
+ internal_error (&iqp->common, "inquire_via_unit(): Bad comma");
+ }
+
+ cf_strcpy (iqp->decimal, iqp->decimal_len, p);
+ }
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_ASYNCHRONOUS) != 0)
+ {
+ if (u == NULL)
+ p = undefined;
+ else
+ switch (u->flags.async)
+ {
+ case ASYNC_YES:
+ p = "YES";
+ break;
+ case ASYNC_NO:
+ p = "NO";
+ break;
+ default:
+ internal_error (&iqp->common, "inquire_via_unit(): Bad async");
+ }
+
+ cf_strcpy (iqp->asynchronous, iqp->asynchronous_len, p);
+ }
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_SIGN) != 0)
+ {
+ if (u == NULL)
+ p = undefined;
+ else
+ switch (u->flags.sign)
+ {
+ case SIGN_PROCDEFINED:
+ p = "PROCESSOR_DEFINED";
+ break;
+ case SIGN_SUPPRESS:
+ p = "SUPPRESS";
+ break;
+ case SIGN_PLUS:
+ p = "PLUS";
+ break;
+ default:
+ internal_error (&iqp->common, "inquire_via_unit(): Bad sign");
+ }
+
+ cf_strcpy (iqp->sign, iqp->sign_len, p);
+ }
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_ROUND) != 0)
+ {
+ if (u == NULL)
+ p = undefined;
+ else
+ switch (u->flags.round)
+ {
+ case ROUND_UP:
+ p = "UP";
+ break;
+ case ROUND_DOWN:
+ p = "DOWN";
+ break;
+ case ROUND_ZERO:
+ p = "ZERO";
+ break;
+ case ROUND_NEAREST:
+ p = "NEAREST";
+ break;
+ case ROUND_COMPATIBLE:
+ p = "COMPATIBLE";
+ break;
+ case ROUND_PROCDEFINED:
+ p = "PROCESSOR_DEFINED";
+ break;
+ default:
+ internal_error (&iqp->common, "inquire_via_unit(): Bad round");
+ }
+
+ cf_strcpy (iqp->round, iqp->round_len, p);
+ }
+
if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
{
if (u == NULL || u->flags.access == ACCESS_DIRECT)
{
const char *p;
GFC_INTEGER_4 cf = iqp->common.flags;
+ GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
*iqp->exist = file_exists (iqp->file, iqp->file_len);
if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
cf_strcpy (iqp->blank, iqp->blank_len, undefined);
+ if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
+ cf_strcpy (iqp->pad, iqp->pad_len, undefined);
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+ cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
+ cf_strcpy (iqp->delim, iqp->delim_len, undefined);
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_DECIMAL) != 0)
+ cf_strcpy (iqp->decimal, iqp->decimal_len, undefined);
+
if ((cf & IOPARM_INQUIRE_HAS_POSITION) != 0)
cf_strcpy (iqp->position, iqp->position_len, undefined);
cf_strcpy (iqp->readwrite, iqp->readwrite_len, p);
}
- if ((cf & IOPARM_INQUIRE_HAS_DELIM) != 0)
+ if ((cf2 & IOPARM_INQUIRE_HAS_DELIM) != 0)
cf_strcpy (iqp->delim, iqp->delim_len, undefined);
- if ((cf & IOPARM_INQUIRE_HAS_PAD) != 0)
+ if ((cf2 & IOPARM_INQUIRE_HAS_PAD) != 0)
cf_strcpy (iqp->pad, iqp->pad_len, undefined);
+
+ if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
+ cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
}
unit_mode;
typedef enum
-{ ASYNC_YES, ASYNC_NO, AYSYNC_UNSPECIFIED }
+{ ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
unit_async;
#define CHARACTER1(name) \
CHARACTER1 (convert);
GFC_INTEGER_4 flags2;
CHARACTER1 (asynchronous);
- CHARACTER1 (decimal);
+ CHARACTER2 (decimal);
CHARACTER1 (encoding);
- CHARACTER1 (pending);
+ CHARACTER2 (pending);
CHARACTER1 (round);
- CHARACTER1 (sign);
+ CHARACTER2 (sign);
GFC_INTEGER_4 *size;
- GFC_IO_INT id;
+ GFC_INTEGER_4 *id;
}
st_parameter_inquire;
int item_count;
unit_mode mode;
unit_blank blank_status;
+ unit_pad pad_status;
enum { SIGN_S, SIGN_SS, SIGN_SP } sign_status;
int scale_factor;
int max_pos; /* Maximum righthand column written to. */
int sf_seen_eor;
unit_advance advance_status;
unit_decimal decimal_status;
+ unit_delim delim_status;
unsigned reversion_flag : 1; /* Format reversion has occurred. */
unsigned first_item : 1;
default:
if (dtp->u.p.namelist_mode)
{
- if (dtp->u.p.current_unit->flags.delim == DELIM_APOSTROPHE
- || dtp->u.p.current_unit->flags.delim == DELIM_QUOTE
+ if (dtp->u.p.delim_status == DELIM_APOSTROPHE
+ || dtp->u.p.delim_status == DELIM_QUOTE
|| c == '&' || c == '$' || c == '/')
{
unget_char (dtp, c);
u->flags.decimal = flags->decimal;
if (flags->encoding != ENCODING_UNSPECIFIED)
u->flags.encoding = flags->encoding;
+ if (flags->async != ASYNC_UNSPECIFIED)
+ u->flags.async = flags->async;
if (flags->round != ROUND_UNSPECIFIED)
u->flags.round = flags->round;
if (flags->sign != SIGN_UNSPECIFIED)
flags->form = (flags->access == ACCESS_SEQUENTIAL)
? FORM_FORMATTED : FORM_UNFORMATTED;
+ if (flags->async == ASYNC_UNSPECIFIED)
+ flags->async = ASYNC_NO;
+
+ if (flags->status == STATUS_UNSPECIFIED)
+ flags->status = STATUS_UNKNOWN;
+
+ /* Checks. */
if (flags->delim == DELIM_UNSPECIFIED)
flags->delim = DELIM_NONE;
if (flags->position == POSITION_UNSPECIFIED)
flags->position = POSITION_ASIS;
-
- if (flags->status == STATUS_UNSPECIFIED)
- flags->status = STATUS_UNKNOWN;
-
- /* Checks. */
-
if (flags->access == ACCESS_DIRECT
&& (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0)
{
find_option (&opp->common, opp->encoding, opp->encoding_len,
encoding_opt, "Bad ENCODING parameter in OPEN statement");
+ flags.async = !(cf & IOPARM_OPEN_HAS_ASYNCHRONOUS) ? ASYNC_UNSPECIFIED :
+ find_option (&opp->common, opp->asynchronous, opp->asynchronous_len,
+ async_opt, "Bad ASYNCHRONOUS 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");
{
if (!is_stream_io (dtp))
{
- if ((dtp->u.p.current_unit->flags.pad == PAD_NO || is_internal_unit (dtp))
+ if ((dtp->u.p.pad_status == PAD_NO || is_internal_unit (dtp))
&& dtp->u.p.current_unit->bytes_left < n)
n = dtp->u.p.current_unit->bytes_left;
{NULL, 0}
};
+static const st_option delim_opt[] = {
+ {"apostrophe", DELIM_APOSTROPHE},
+ {"quote", DELIM_QUOTE},
+ {"none", DELIM_NONE},
+ {NULL, 0}
+};
+
+static const st_option pad_opt[] = {
+ {"yes", PAD_YES},
+ {"no", PAD_NO},
+ {NULL, 0}
+};
+
typedef enum
{ FORMATTED_SEQUENTIAL, UNFORMATTED_SEQUENTIAL,
FORMATTED_DIRECT, UNFORMATTED_DIRECT, FORMATTED_STREAM, UNFORMATTED_STREAM
/* Without padding, terminate the I/O statement without assigning
the value. With padding, the value still needs to be assigned,
so we can just continue with a short read. */
- if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+ if (dtp->u.p.pad_status == PAD_NO)
{
if (no_error)
break;
dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
else
{
- if (dtp->u.p.current_unit->flags.pad == PAD_NO)
+ if (dtp->u.p.pad_status == PAD_NO)
{
/* Not enough data left. */
generate_error (&dtp->common, LIBERROR_EOR, NULL);
if (nread != *length)
{ /* Short read, this shouldn't happen. */
- if (dtp->u.p.current_unit->flags.pad == PAD_YES)
+ if (dtp->u.p.pad_status == PAD_YES)
*length = nread;
else
{
u_flags.pad = PAD_UNSPECIFIED;
u_flags.decimal = DECIMAL_UNSPECIFIED;
u_flags.encoding = ENCODING_UNSPECIFIED;
+ u_flags.async = ASYNC_UNSPECIFIED;
u_flags.round = ROUND_UNSPECIFIED;
u_flags.sign = SIGN_UNSPECIFIED;
u_flags.status = STATUS_UNKNOWN;
if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
dtp->u.p.blank_status = dtp->u.p.current_unit->flags.blank;
+
+ /* Check the delim mode. */
+ dtp->u.p.delim_status
+ = !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED :
+ find_option (&dtp->common, dtp->delim, dtp->delim_len, delim_opt,
+ "Bad DELIM parameter in data transfer statement");
+
+ if (dtp->u.p.delim_status == DELIM_UNSPECIFIED)
+ dtp->u.p.delim_status = dtp->u.p.current_unit->flags.delim;
+
+ /* Check the pad mode. */
+ dtp->u.p.pad_status
+ = !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED :
+ find_option (&dtp->common, dtp->pad, dtp->pad_len, pad_opt,
+ "Bad PAD parameter in data transfer statement");
+
+ if (dtp->u.p.pad_status == PAD_UNSPECIFIED)
+ dtp->u.p.pad_status = dtp->u.p.current_unit->flags.pad;
-
/* Sanity checks on the record number. */
if ((cf & IOPARM_DT_HAS_REC) != 0)
{
iunit->flags.sign = SIGN_SUPPRESS;
iunit->flags.decimal = DECIMAL_POINT;
iunit->flags.encoding = ENCODING_DEFAULT;
+ iunit->flags.async = ASYNC_NO;
/* Initialize the data transfer parameters. */
u->flags.sign = SIGN_SUPPRESS;
u->flags.decimal = DECIMAL_POINT;
u->flags.encoding = ENCODING_DEFAULT;
-
+ u->flags.async = ASYNC_NO;
+
u->recl = options.default_recl;
u->endfile = NO_ENDFILE;
u->flags.sign = SIGN_SUPPRESS;
u->flags.decimal = DECIMAL_POINT;
u->flags.encoding = ENCODING_DEFAULT;
+ u->flags.async = ASYNC_NO;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
u->flags.sign = SIGN_SUPPRESS;
u->flags.decimal = DECIMAL_POINT;
u->flags.encoding = ENCODING_DEFAULT;
+ u->flags.async = ASYNC_NO;
u->recl = options.default_recl;
u->endfile = AT_ENDFILE;
int i, extra;
char *p, d;
- switch (dtp->u.p.current_unit->flags.delim)
+ switch (dtp->u.p.delim_status)
{
case DELIM_APOSTROPHE:
d = '\'';
else
{
if (type != BT_CHARACTER || !dtp->u.p.char_flag ||
- dtp->u.p.current_unit->flags.delim != DELIM_NONE)
+ dtp->u.p.delim_status != DELIM_NONE)
write_separator (dtp);
}
break;
case GFC_DTYPE_CHARACTER:
- tmp_delim = dtp->u.p.current_unit->flags.delim;
+ tmp_delim = dtp->u.p.delim_status;
if (dtp->u.p.nml_delim == '"')
- dtp->u.p.current_unit->flags.delim = DELIM_QUOTE;
+ dtp->u.p.delim_status = DELIM_QUOTE;
if (dtp->u.p.nml_delim == '\'')
- dtp->u.p.current_unit->flags.delim = DELIM_APOSTROPHE;
+ dtp->u.p.delim_status = DELIM_APOSTROPHE;
write_character (dtp, p, obj->string_length);
- dtp->u.p.current_unit->flags.delim = tmp_delim;
+ dtp->u.p.delim_status = tmp_delim;
break;
case GFC_DTYPE_REAL:
/* Set the delimiter for namelist output. */
- tmp_delim = dtp->u.p.current_unit->flags.delim;
+ tmp_delim = dtp->u.p.delim_status;
switch (tmp_delim)
{
case (DELIM_QUOTE):
}
/* Temporarily disable namelist delimters. */
- dtp->u.p.current_unit->flags.delim = DELIM_NONE;
+ dtp->u.p.delim_status = DELIM_NONE;
write_character (dtp, "&", 1);
#endif
/* Restore the original delimiter. */
- dtp->u.p.current_unit->flags.delim = tmp_delim;
+ dtp->u.p.delim_status = tmp_delim;
}
#undef NML_DIGITS
projects / gcc.git / commitdiff