Commit 0be72e3a by Jerry DeLisle

re PR libfortran/33253 (namelist: reading back a string with apostrophe)

2007-09-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/33253
	* io/write.c (nml_write_obj): Set the delimiter correctly before calling
	write_character. (namelist_write): Clean up the code a little and add
	comments to clarify what its doing.

From-SVN: r128170
parent 22181850
2007-03-04 Jerry DeLisle <jvdelisle@gcc.gnu.org> 2007-09-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/33253
* io/write.c (nml_write_obj): Set the delimiter correctly before calling
write_character. (namelist_write): Clean up the code a little and add
comments to clarify what its doing.
2007-09-04 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/33225 PR libfortran/33225
* io/write.c (stdbool.h): Add include. (sign_t): Move typedef to * io/write.c (stdbool.h): Add include. (sign_t): Move typedef to
......
...@@ -868,6 +868,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, ...@@ -868,6 +868,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
size_t base_name_len; size_t base_name_len;
size_t base_var_name_len; size_t base_var_name_len;
size_t tot_len; size_t tot_len;
unit_delim tmp_delim;
/* Write namelist variable names in upper case. If a derived type, /* Write namelist variable names in upper case. If a derived type,
nothing is output. If a component, base and base_name are set. */ nothing is output. If a component, base and base_name are set. */
...@@ -984,11 +985,13 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset, ...@@ -984,11 +985,13 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
break; break;
case GFC_DTYPE_CHARACTER: case GFC_DTYPE_CHARACTER:
if (dtp->u.p.nml_delim) tmp_delim = dtp->u.p.current_unit->flags.delim;
write_character (dtp, &dtp->u.p.nml_delim, 1); if (dtp->u.p.nml_delim == '"')
dtp->u.p.current_unit->flags.delim = DELIM_QUOTE;
if (dtp->u.p.nml_delim == '\'')
dtp->u.p.current_unit->flags.delim = DELIM_APOSTROPHE;
write_character (dtp, p, obj->string_length); write_character (dtp, p, obj->string_length);
if (dtp->u.p.nml_delim) dtp->u.p.current_unit->flags.delim = tmp_delim;
write_character (dtp, &dtp->u.p.nml_delim, 1);
break; break;
case GFC_DTYPE_REAL: case GFC_DTYPE_REAL:
...@@ -1130,7 +1133,6 @@ namelist_write (st_parameter_dt *dtp) ...@@ -1130,7 +1133,6 @@ namelist_write (st_parameter_dt *dtp)
/* Set the delimiter for namelist output. */ /* Set the delimiter for namelist output. */
tmp_delim = dtp->u.p.current_unit->flags.delim; tmp_delim = dtp->u.p.current_unit->flags.delim;
dtp->u.p.current_unit->flags.delim = DELIM_NONE;
switch (tmp_delim) switch (tmp_delim)
{ {
case (DELIM_QUOTE): case (DELIM_QUOTE):
...@@ -1146,10 +1148,12 @@ namelist_write (st_parameter_dt *dtp) ...@@ -1146,10 +1148,12 @@ namelist_write (st_parameter_dt *dtp)
break; break;
} }
/* Temporarily disable namelist delimters. */
dtp->u.p.current_unit->flags.delim = DELIM_NONE;
write_character (dtp, "&", 1); write_character (dtp, "&", 1);
/* Write namelist name in upper case - f95 std. */ /* Write namelist name in upper case - f95 std. */
for (i = 0 ;i < dtp->namelist_name_len ;i++ ) for (i = 0 ;i < dtp->namelist_name_len ;i++ )
{ {
c = toupper (dtp->namelist_name[i]); c = toupper (dtp->namelist_name[i]);
...@@ -1165,14 +1169,14 @@ namelist_write (st_parameter_dt *dtp) ...@@ -1165,14 +1169,14 @@ namelist_write (st_parameter_dt *dtp)
t1 = nml_write_obj (dtp, t2, dummy_offset, dummy, dummy_name); t1 = nml_write_obj (dtp, t2, dummy_offset, dummy, dummy_name);
} }
} }
#ifdef HAVE_CRLF #ifdef HAVE_CRLF
write_character (dtp, " /\r\n", 5); write_character (dtp, " /\r\n", 5);
#else #else
write_character (dtp, " /\n", 4); write_character (dtp, " /\n", 4);
#endif #endif
/* Recover the original delimiter. */ /* Restore the original delimiter. */
dtp->u.p.current_unit->flags.delim = tmp_delim; dtp->u.p.current_unit->flags.delim = tmp_delim;
} }
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment