This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch, libgforran] PR37294 Namelist I/O to array character internal units


The attached patch fixes this bug by using the internal array unit loop specification to advance to the next record in the array as needed. Fairly straight forward.

Regression tested on x86-64-gnu-linux.

OK to commit?

Jerry

2008-11-09 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libfortran/37294
	* io/write.c (namelist_write_newline): Use array loop specification to
	advance to next internal array unit record. (namelist_write): Adjust to
	accomodate the internal array unit behavior.
Index: write.c
===================================================================
--- write.c	(revision 141721)
+++ write.c	(working copy)
@@ -1146,6 +1146,35 @@ namelist_write_newline (st_parameter_dt 
 #else
       write_character (dtp, "\n", 1, 1);
 #endif
+      return;
+    }
+
+  if (is_array_io (dtp))
+    {
+      gfc_offset record;
+      int finished, length;
+
+      length = (int) dtp->u.p.current_unit->bytes_left;
+	      
+      /* Now that the current record has been padded out,
+	 determine where the next record in the array is. */
+      record = next_array_record (dtp, dtp->u.p.current_unit->ls,
+				  &finished);
+      if (finished)
+	dtp->u.p.current_unit->endfile = AT_ENDFILE;
+      else
+	{
+	  /* Now seek to this record */
+	  record = record * dtp->u.p.current_unit->recl;
+
+	  if (sseek (dtp->u.p.current_unit->s, record) == FAILURE)
+	    {
+	      generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
+	      return;
+	    }
+
+	  dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl;
+	}
     }
   else
     write_character (dtp, " ", 1, 1);
@@ -1467,8 +1496,8 @@ namelist_write (st_parameter_dt *dtp)
 	}
     }
 
-  write_character (dtp, "  /", 1, 3);
   namelist_write_newline (dtp);
+  write_character (dtp, " /", 1, 2);
   /* Restore the original delimiter.  */
   dtp->u.p.current_unit->delim_status = tmp_delim;
 }
! { dg-do run }
! PR37294 Namelist I/O to array character internal units.
! Test case from adapted from PR by Jerry DeLisle <jvdelisle@gcc.gnu.org>
  character(30) :: line(3)
  namelist /stuff/ n
  n = 123
  line = ""
  write(line,nml=stuff)
  if (line(1) .ne. "&STUFF") call abort
  if (line(2) .ne. " N=        123,") call abort
  if (line(3) .ne. " /") call abort
  end 

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]