| 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
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
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,