OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

PR fortran/25829 28655

Browse Source 
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.

From-SVN: r133988
This commit is contained in:
Jerry DeLisle 2008-04-07 22:05:52 +00:00
parent c2b58ba219
commit 931149a6b7
9 changed files with 255 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
libgfortran/ChangeLog
View File

@ -1,3 +1,24 @@
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

165
libgfortran/io/inquire.c
View File

@ -43,6 +43,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
{
const char *p;
GFC_INTEGER_4 cf = iqp->common.flags;
GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
{
@ -213,7 +214,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
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)
@ -231,6 +232,148 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
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)
@ -380,6 +523,7 @@ inquire_via_filename (st_parameter_inquire *iqp)
{
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);
@ -435,6 +579,18 @@ inquire_via_filename (st_parameter_inquire *iqp)
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);
@ -459,11 +615,14 @@ inquire_via_filename (st_parameter_inquire *iqp)
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);
}

12
libgfortran/io/io.h
View File

@ -235,7 +235,7 @@ typedef enum
unit_mode;
typedef enum
{ ASYNC_YES, ASYNC_NO, AYSYNC_UNSPECIFIED }
{ ASYNC_YES, ASYNC_NO, ASYNC_UNSPECIFIED }
unit_async;
#define CHARACTER1(name) \
@ -342,13 +342,13 @@ typedef struct
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;
@ -409,6 +409,7 @@ typedef struct st_parameter_dt
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. */
@ -423,6 +424,7 @@ typedef struct st_parameter_dt
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;

4
libgfortran/io/list_read.c
View File

@ -943,8 +943,8 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
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);

19
libgfortran/io/open.c
View File

@ -254,6 +254,8 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
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)
@ -317,6 +319,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
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;
@ -424,12 +433,6 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
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)
{
@ -739,6 +742,10 @@ st_open (st_parameter_open *opp)
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");

2
libgfortran/io/read.c
View File

@ -854,7 +854,7 @@ read_x (st_parameter_dt *dtp, int n)
{
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;

39
libgfortran/io/transfer.c
View File

@ -114,6 +114,19 @@ static const st_option blank_opt[] = {
{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
@ -242,7 +255,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
/* 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;
@ -320,7 +333,7 @@ read_block (st_parameter_dt *dtp, int *length)
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);
@ -358,7 +371,7 @@ read_block (st_parameter_dt *dtp, int *length)
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
{
@ -1802,6 +1815,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
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;
@ -2020,8 +2034,25 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
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)
{

6
libgfortran/io/unit.c
View File

@ -443,6 +443,7 @@ get_internal_unit (st_parameter_dt *dtp)
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. */
@ -531,7 +532,8 @@ init_units (void)
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;
@ -557,6 +559,7 @@ init_units (void)
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;
@ -583,6 +586,7 @@ init_units (void)
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;

18
libgfortran/io/write.c
View File

@ -640,7 +640,7 @@ write_character (st_parameter_dt *dtp, const char *source, int length)
int i, extra;
char *p, d;
switch (dtp->u.p.current_unit->flags.delim)
switch (dtp->u.p.delim_status)
{
case DELIM_APOSTROPHE:
d = '\'';
@ -779,7 +779,7 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
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);
}
@ -994,13 +994,13 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
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:
@ -1141,7 +1141,7 @@ namelist_write (st_parameter_dt *dtp)
/* 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):
@ -1158,7 +1158,7 @@ namelist_write (st_parameter_dt *dtp)
}
/* Temporarily disable namelist delimters. */
dtp->u.p.current_unit->flags.delim = DELIM_NONE;
dtp->u.p.delim_status = DELIM_NONE;
write_character (dtp, "&", 1);
@ -1186,7 +1186,7 @@ namelist_write (st_parameter_dt *dtp)
#endif
/* Restore the original delimiter. */
dtp->u.p.current_unit->flags.delim = tmp_delim;
dtp->u.p.delim_status = tmp_delim;
}
#undef NML_DIGITS