re PR fortran/36895 (Namelist writting to internal files: Control characters wrong?)

2008-08-30  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/36895
	* io/write.c (namelist_write_newline): New function to correctly mark
	next records in both external and internal units.
	(nml_write_obj): Use new function.
	(namelist_write: Use new function.

From-SVN: r139813
This commit is contained in:
Jerry DeLisle 2008-08-31 00:04:33 +00:00
parent 5779e7133d
commit 8c8627c472
2 changed files with 32 additions and 16 deletions

View File

@ -1,3 +1,11 @@
2008-08-30 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/36895
* io/write.c (namelist_write_newline): New function to correctly mark
next records in both external and internal units.
(nml_write_obj): Use new function.
(namelist_write: Use new function.
2008-08-19 Tobias Burnus <burnus@net-b.de>
PR libfortran/35863

View File

@ -1116,6 +1116,22 @@ list_formatted_write (st_parameter_dt *dtp, bt type, void *p, int kind,
#define NML_DIGITS 20
static void
namelist_write_newline (st_parameter_dt *dtp)
{
if (!is_internal_unit (dtp))
{
#ifdef HAVE_CRLF
write_character (dtp, "\r\n", 1, 2);
#else
write_character (dtp, "\n", 1, 1);
#endif
}
else
write_character (dtp, " ", 1, 1);
}
static namelist_info *
nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
namelist_info * base, char * base_name)
@ -1152,11 +1168,9 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
if (obj->type != GFC_DTYPE_DERIVED)
{
#ifdef HAVE_CRLF
write_character (dtp, "\r\n ", 1, 3);
#else
write_character (dtp, "\n ", 1, 2);
#endif
namelist_write_newline (dtp);
write_character (dtp, " ", 1, 1);
len = 0;
if (base)
{
@ -1361,11 +1375,8 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
if (num > 5)
{
num = 0;
#ifdef HAVE_CRLF
write_character (dtp, "\r\n ", 1, 3);
#else
write_character (dtp, "\n ", 1, 2);
#endif
namelist_write_newline (dtp);
write_character (dtp, " ", 1, 1);
}
rep_ctr = 1;
}
@ -1392,6 +1403,7 @@ obj_loop:
return retval;
}
/* This is the entry function for namelist writes. It outputs the name
of the namelist and iterates through the namelist by calls to
nml_write_obj. The call below has dummys in the arguments used in
@ -1447,12 +1459,8 @@ namelist_write (st_parameter_dt *dtp)
}
}
#ifdef HAVE_CRLF
write_character (dtp, " /\r\n", 1, 5);
#else
write_character (dtp, " /\n", 1, 4);
#endif
write_character (dtp, " /", 1, 3);
namelist_write_newline (dtp);
/* Restore the original delimiter. */
dtp->u.p.delim_status = tmp_delim;
}