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

re PR fortran/60148 (strings in NAMELIST do not honor DELIM= in open statement)

Browse Source 
2014-03-03  Jerry DeLisle  <jvdelisle@gcc.gnu>

	PR libfortran/60148
	* io/inquire.c (inquire_via_unit): In the case of
	DELIM_UNSPECIFIED set inquire return string to "NONE".
	* io/list_read.c (read_character): In the case of DELIM_NONE and
	namelists, complete the character read using the namelist
	variable length.
	* io/open.c (new_unit): Don't set delim status to none if not
	specified so that DELIM_UNSPECIFIED can be used later.
	* io/transfer.c (data_transfer_init): For namelist I/O, if the
	unit delim status is unspecified set the current status to quote.
	Otherwise, set current status to the unit status.
	* io/unit.c (get_internel_unit, init_unit): Remember to set
	flags_delim initially to DELIM_UNSPECIFIED so defaults come out
	correctly.
	* io/write.c (write_character): Add a new function argument
	"mode" to signify that raw output is to be used vs output with
	delimiters. If the mode is set to DELIM (1) proceed with
	delimiters. (list_formatted_write_scalar): Write the separator
	only if a delimiter was previously specified. Update the call to
	write_character with the mode argument given.
	(namelist_write_newline): Use the mode argument. (nml_write_obj):
	Use the mode argument. Remove use of tmp_delim. Write the
	semi-colon or comma correctly only when needed with using
	delimiters. Cleanup whitespace.
	(namelist_write): If delim is not specified in namelist I/O,
	default	to using quotes. Get rid of the tmp_delim variable and
	use the new mode argument in write_character.

From-SVN: r208302
This commit is contained in:
Jerry DeLisle 2014-03-04 04:33:40 +00:00
parent 915182a087
commit 75b2dba9ae
7 changed files with 129 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
libgfortran/ChangeLog
View File

@ -1,3 +1,33 @@
2014-03-03 Jerry DeLisle <jvdelisle@gcc.gnu>
PR libfortran/60148
* io/inquire.c (inquire_via_unit): In the case of
DELIM_UNSPECIFIED set inquire return string to "NONE".
* io/list_read.c (read_character): In the case of DELIM_NONE and
namelists, complete the character read using the namelist
variable length.
* io/open.c (new_unit): Don't set delim status to none if not
specified so that DELIM_UNSPECIFIED can be used later.
* io/transfer.c (data_transfer_init): For namelist I/O, if the
unit delim status is unspecified set the current status to quote.
Otherwise, set current status to the unit status.
* io/unit.c (get_internel_unit, init_unit): Remember to set
flags_delim initially to DELIM_UNSPECIFIED so defaults come out
correctly.
* io/write.c (write_character): Add a new function argument
"mode" to signify that raw output is to be used vs output with
delimiters. If the mode is set to DELIM (1) proceed with
delimiters. (list_formatted_write_scalar): Write the separator
only if a delimiter was previously specified. Update the call to
write_character with the mode argument given.
(namelist_write_newline): Use the mode argument. (nml_write_obj):
Use the mode argument. Remove use of tmp_delim. Write the
semi-colon or comma correctly only when needed with using
delimiters. Cleanup whitespace.
(namelist_write): If delim is not specified in namelist I/O,
default to using quotes. Get rid of the tmp_delim variable and
use the new mode argument in write_character.
2014-02-21 Tobias Burnus <burnus@net-b.de>
PR fortran/60286

1
libgfortran/io/inquire.c
View File

@ -523,6 +523,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
switch (u->flags.delim)
{
case DELIM_NONE:
case DELIM_UNSPECIFIED:
p = "NONE";
break;
case DELIM_QUOTE:

16
libgfortran/io/list_read.c
View File

@ -971,10 +971,24 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
default:
if (dtp->u.p.namelist_mode)
{
if (dtp->u.p.current_unit->delim_status == DELIM_NONE)
{
/* No delimiters so finish reading the string now. */
int i;
push_char (dtp, c);
for (i = dtp->u.p.ionml->string_length; i > 1; i--)
{
if ((c = next_char (dtp)) == EOF)
goto done_eof;
push_char (dtp, c);
}
dtp->u.p.saved_type = BT_CHARACTER;
free_line (dtp);
return;
}
unget_char (dtp, c);
return;
}
push_char (dtp, c);
goto get_string;
}

16
libgfortran/io/open.c
View File

@ -332,17 +332,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
/* Checks. */
if (flags->delim == DELIM_UNSPECIFIED)
flags->delim = DELIM_NONE;
else
if (flags->delim != DELIM_UNSPECIFIED
&& flags->form == FORM_UNFORMATTED)
{
if (flags->form == FORM_UNFORMATTED)
{
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto fail;
}
generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
"DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement");
goto fail;
}
if (flags->blank == BLANK_UNSPECIFIED)

11
libgfortran/io/transfer.c
View File

@ -2670,16 +2670,21 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
= !(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.current_unit->delim_status == DELIM_UNSPECIFIED)
dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim;
{
if (ionml && dtp->u.p.current_unit->flags.delim == DELIM_UNSPECIFIED)
dtp->u.p.current_unit->delim_status = DELIM_QUOTE;
else
dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim;
}
/* Check the pad mode. */
dtp->u.p.current_unit->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.current_unit->pad_status == PAD_UNSPECIFIED)
dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad;

2
libgfortran/io/unit.c
View File

@ -464,6 +464,7 @@ get_internal_unit (st_parameter_dt *dtp)
iunit->flags.status = STATUS_UNSPECIFIED;
iunit->flags.sign = SIGN_SUPPRESS;
iunit->flags.decimal = DECIMAL_POINT;
iunit->flags.delim = DELIM_UNSPECIFIED;
iunit->flags.encoding = ENCODING_DEFAULT;
iunit->flags.async = ASYNC_NO;
iunit->flags.round = ROUND_UNSPECIFIED;
@ -584,6 +585,7 @@ init_units (void)
u->flags.position = POSITION_ASIS;
u->flags.sign = SIGN_SUPPRESS;
u->flags.decimal = DECIMAL_POINT;
u->flags.delim = DELIM_UNSPECIFIED;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
u->flags.round = ROUND_UNSPECIFIED;

121
libgfortran/io/write.c
View File

@ -1312,24 +1312,32 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
/* Write a list-directed string. We have to worry about delimiting
the strings if the file has been opened in that mode. */
#define DELIM 1
#define NODELIM 0
static void
write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
write_character (st_parameter_dt *dtp, const char *source, int kind, int length, int mode)
{
int i, extra;
char *p, d;
switch (dtp->u.p.current_unit->delim_status)
if (mode == DELIM)
{
case DELIM_APOSTROPHE:
d = '\'';
break;
case DELIM_QUOTE:
d = '"';
break;
default:
d = ' ';
break;
switch (dtp->u.p.current_unit->delim_status)
{
case DELIM_APOSTROPHE:
d = '\'';
break;
case DELIM_QUOTE:
d = '"';
break;
default:
d = ' ';
break;
}
}
else
d = ' ';
if (kind == 1)
{
@ -1551,7 +1559,8 @@ 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->delim_status != DELIM_NONE)
(dtp->u.p.current_unit->delim_status != DELIM_NONE
&& dtp->u.p.current_unit->delim_status != DELIM_UNSPECIFIED))
write_separator (dtp);
}
@ -1564,7 +1573,7 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
write_logical (dtp, p, kind);
break;
case BT_CHARACTER:
write_character (dtp, p, kind, size);
write_character (dtp, p, kind, size, DELIM);
break;
case BT_REAL:
write_real (dtp, p, kind);
@ -1628,9 +1637,9 @@ namelist_write_newline (st_parameter_dt *dtp)
if (!is_internal_unit (dtp))
{
#ifdef HAVE_CRLF
write_character (dtp, "\r\n", 1, 2);
write_character (dtp, "\r\n", 1, 2, NODELIM);
#else
write_character (dtp, "\n", 1, 1);
write_character (dtp, "\n", 1, 1, NODELIM);
#endif
return;
}
@ -1675,7 +1684,7 @@ namelist_write_newline (st_parameter_dt *dtp)
}
}
else
write_character (dtp, " ", 1, 1);
write_character (dtp, " ", 1, 1, NODELIM);
}
@ -1704,7 +1713,6 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
size_t base_name_len;
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. */
@ -1718,7 +1726,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
if (obj->type != BT_DERIVED)
{
namelist_write_newline (dtp);
write_character (dtp, " ", 1, 1);
write_character (dtp, " ", 1, 1, NODELIM);
len = 0;
if (base)
@ -1728,16 +1736,16 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
for (dim_i = 0; dim_i < base_name_len; dim_i++)
{
cup = toupper ((int) base_name[dim_i]);
write_character (dtp, &cup, 1, 1);
write_character (dtp, &cup, 1, 1, NODELIM);
}
}
clen = strlen (obj->var_name);
for (dim_i = len; dim_i < clen; dim_i++)
{
cup = toupper ((int) obj->var_name[dim_i]);
write_character (dtp, &cup, 1, 1);
write_character (dtp, &cup, 1, 1, NODELIM);
}
write_character (dtp, "=", 1, 1);
write_character (dtp, "=", 1, 1, NODELIM);
}
/* Counts the number of data output on a line, including names. */
@ -1807,7 +1815,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
if (rep_ctr > 1)
{
snprintf(rep_buff, NML_DIGITS, " %d*", rep_ctr);
write_character (dtp, rep_buff, 1, strlen (rep_buff));
write_character (dtp, rep_buff, 1, strlen (rep_buff), NODELIM);
dtp->u.p.no_leading_blank = 1;
}
num++;
@ -1827,13 +1835,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
break;
case BT_CHARACTER:
tmp_delim = dtp->u.p.current_unit->delim_status;
if (dtp->u.p.nml_delim == '"')
dtp->u.p.current_unit->delim_status = DELIM_QUOTE;
if (dtp->u.p.nml_delim == '\'')
dtp->u.p.current_unit->delim_status = DELIM_APOSTROPHE;
write_character (dtp, p, 1, obj->string_length);
dtp->u.p.current_unit->delim_status = tmp_delim;
write_character (dtp, p, 1, obj->string_length, DELIM);
break;
case BT_REAL:
@ -1921,12 +1923,20 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
to column 2. Reset the repeat counter. */
dtp->u.p.no_leading_blank = 0;
write_character (dtp, &semi_comma, 1, 1);
if (obj->type == BT_CHARACTER)
{
if (dtp->u.p.nml_delim != '\0')
write_character (dtp, &semi_comma, 1, 1, NODELIM);
}
else
write_character (dtp, &semi_comma, 1, 1, NODELIM);
if (num > 5)
{
num = 0;
if (dtp->u.p.nml_delim == '\0')
write_character (dtp, &semi_comma, 1, 1, NODELIM);
namelist_write_newline (dtp);
write_character (dtp, " ", 1, 1);
write_character (dtp, " ", 1, 1, NODELIM);
}
rep_ctr = 1;
}
@ -1935,17 +1945,17 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
obj_loop:
nml_carry = 1;
for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++)
{
obj->ls[dim_i].idx += nml_carry ;
nml_carry = 0;
if (obj->ls[dim_i].idx > GFC_DESCRIPTOR_UBOUND(obj,dim_i))
{
obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i);
nml_carry = 1;
}
}
nml_carry = 1;
for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++)
{
obj->ls[dim_i].idx += nml_carry ;
nml_carry = 0;
if (obj->ls[dim_i].idx > GFC_DESCRIPTOR_UBOUND(obj,dim_i))
{
obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i);
nml_carry = 1;
}
}
}
/* Return a pointer beyond the furthest object accessed. */
@ -1967,23 +1977,28 @@ namelist_write (st_parameter_dt *dtp)
index_type dummy_offset = 0;
char c;
char * dummy_name = NULL;
unit_delim tmp_delim = DELIM_UNSPECIFIED;
/* Set the delimiter for namelist output. */
tmp_delim = dtp->u.p.current_unit->delim_status;
switch (dtp->u.p.current_unit->delim_status)
{
case DELIM_APOSTROPHE:
dtp->u.p.nml_delim = '\'';
break;
case DELIM_QUOTE:
case DELIM_UNSPECIFIED:
dtp->u.p.nml_delim = '"';
break;
default:
dtp->u.p.nml_delim = '\0';
}
dtp->u.p.nml_delim = tmp_delim == DELIM_APOSTROPHE ? '\'' : '"';
/* Temporarily disable namelist delimters. */
dtp->u.p.current_unit->delim_status = DELIM_NONE;
write_character (dtp, "&", 1, 1);
write_character (dtp, "&", 1, 1, NODELIM);
/* Write namelist name in upper case - f95 std. */
for (i = 0 ;i < dtp->namelist_name_len ;i++ )
{
c = toupper ((int) dtp->namelist_name[i]);
write_character (dtp, &c, 1 ,1);
write_character (dtp, &c, 1 ,1, NODELIM);
}
if (dtp->u.p.ionml != NULL)
@ -1997,9 +2012,7 @@ namelist_write (st_parameter_dt *dtp)
}
namelist_write_newline (dtp);
write_character (dtp, " /", 1, 2);
/* Restore the original delimiter. */
dtp->u.p.current_unit->delim_status = tmp_delim;
write_character (dtp, " /", 1, 2, NODELIM);
}
#undef NML_DIGITS