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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@139813 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 7b53360..f8083c8 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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

diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 97aed53..65210bc 100644 (file)
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -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;
 }