git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
libgfortran/ChangeLog
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> 2008-08-19 Tobias Burnus <burnus@net-b.de>
PR libfortran/35863 PR libfortran/35863

40
libgfortran/io/write.c
View File

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