This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, libgfortran] PR36895 Namelist writing to internal files
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: Fortran List <fortran at gcc dot gnu dot org>
- Cc: gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 30 Aug 2008 14:41:40 -0700
- Subject: [patch, libgfortran] PR36895 Namelist writing to internal files
Hi Folks,
This patch factors the relevant code into a new function to mark the records for
namelist writes. I then use a " " instead of control characters for the end of
the record. Fairly simple.
gfortran does not currently address character arrays in namelist I/O. At the
time we were doing internal units, we did not think it was worth the effort. I
would like to leave that as a future exercise. The place to do it is in this
new function now and it requires porting the next record code over from
next_record in io/transfer.c.
Regression tested on x86-64. OK for trunk. It is mostly obvious. I will
include a simple test case.
Regards,
Jerry
2008-08-15 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.
Index: write.c
===================================================================
--- write.c (revision 139804)
+++ write.c (working copy)
@@ -1116,6 +1116,22 @@ list_formatted_write (st_parameter_dt *d
#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, nam
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, nam
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;
}