Patchwork [libgfortran] PR45710 Adjust format and padding for WRITE of NAMELIST group to internal file

login
register
mail settings
Submitter Jerry DeLisle
Date Sept. 22, 2010, 3:31 a.m.
Message ID <4C9978A4.6010601@frontier.com>
Download mbox | patch
Permalink /patch/65395/
State New
Headers show

Comments

Jerry DeLisle - Sept. 22, 2010, 3:31 a.m.
Hi,

This patch pads the end of records with ' ' for internal character unit arrays. 
The patch is fairly obvious.  Code borrowed from transfer.c.

Regression tested ob x86-64.

OK for trunk.

I will also add a test case.

Regards,

Jerry

2010-09-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/45710
	* io/write.c (namelist_write_newline): Pad character array internal
	unit records with spaces.
Jerry DeLisle - Sept. 22, 2010, 4:30 a.m.
On 09/21/2010 08:31 PM, Jerry DeLisle wrote:
> Hi,
>
> This patch pads the end of records with ' ' for internal character unit arrays.
> The patch is fairly obvious. Code borrowed from transfer.c.
>
> Regression tested ob x86-64.
>
> OK for trunk.
>
> I will also add a test case.
>
> Regards,
>
> Jerry
>
> 2010-09-21 Jerry DeLisle <jvdelisle@gcc.gnu.org>
>
> PR libfortran/45710
> * io/write.c (namelist_write_newline): Pad character array internal
> unit records with spaces.

Here is the test case attached.

Regards,

Jerry
! { dg-do run }
! { dg-options "-std=gnu" }
! PR45710 Adjust format/padding for WRITE of NAMELIST group to internal file
program oneline
real :: a=1,b=2,c=3,d=4
namelist /nl1/ a,b,c
parameter(ilines=5)
character(len=80) :: out(ilines)

! fill array out with @
do i=1,len(out)
   out(:)(i:i)='@'
enddo

write(out,nl1)
if (trim(out(1)).ne."&NL1") call abort
if (trim(out(2)).ne." A=  1.0000000    ,") call abort
if (trim(out(3)).ne." B=  2.0000000    ,") call abort
if (trim(out(4)).ne." C=  3.0000000    ,") call abort
if (trim(out(5)).ne." /") call abort

end program oneline
Tobias Burnus - Sept. 22, 2010, 6:16 a.m.
Am 22.09.2010 05:31, schrieb Jerry DeLisle:
>
> This patch pads the end of records with ' ' for internal character 
> unit arrays. The patch is fairly obvious.  Code borrowed from transfer.c.
>
> Regression tested ob x86-64.
> OK for trunk.

OK. Thanks for the patch!

> I will also add a test case.
The trim in comparisons such as

   if (trim(out(3)).ne." B=  2.0000000    ,") call abort

is not needed (except that the program takes a bit longer to 
compile/run); the trim() in comparisons  will also be optimized away for 
-O<n>, n>0 by the FE. But as it does not harm, you can leave it.

Tobias

Patch

Index: write.c
===================================================================
--- write.c	(revision 164472)
+++ write.c	(working copy)
@@ -1630,7 +1630,21 @@  namelist_write_newline (st_parameter_dt *dtp)
     {
       gfc_offset record;
       int finished;
+      char *p;
+      int length = dtp->u.p.current_unit->bytes_left;
 
+      p = write_block (dtp, length);
+      if (p == NULL)
+	return;
+
+      if (unlikely (is_char4_unit (dtp)))
+	{
+	  gfc_char4_t *p4 = (gfc_char4_t *) p;
+	  memset4 (p4, ' ', length);
+	}
+      else
+	memset (p, ' ', length);
+
       /* 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,