This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[gfortran] Real output with scale factor
- From: Paul Brook <paul at codesourcery dot com>
- To: fortran at gcc dot gnu dot org
- Cc: "gcc-patches at gcc dot gnu dot org" <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 2 Sep 2004 02:33:10 +0100
- Subject: [gfortran] Real output with scale factor
- Organization: CodeSourcery
The patch below fixes output of real numbers with a nonzero scale factor.
The fist bit makes sure P edit descriptors actually get used, the second fixes
bugs in the exponet and number of significant digits calculations.
Tested on i686-linux.
Applied to mainline.
Paul
2004-09-02 Paul Brook <paul@codesourcery.com>
* io/format.c (parse_format_list): Set repeat count for P descriptors.
* write.c (output_float): Fix condition. Correctly handle nonzero
scale factor.
testsuite/
* gfortran.dg/edit_real_1.f90: Add new tests.
Index: gcc/testsuite/gfortran.dg/edit_real_1.f90
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/gcc/testsuite/gfortran.dg/edit_real_1.f90,v
retrieving revision 1.1
diff -u -p -r1.1 edit_real_1.f90
--- gcc/testsuite/gfortran.dg/edit_real_1.f90 28 Aug 2004 19:48:01 -0000 1.1
+++ gcc/testsuite/gfortran.dg/edit_real_1.f90 2 Sep 2004 01:22:40 -0000
@@ -62,5 +62,13 @@ program edit_real_1
s = x
write (s, '(EN15.3,A)') 999.9999, "z"
if (s .ne. " 1.000E+03z") call abort
+ ! E format, positive scale factor
+ s = x
+ write (s, '(2PE10.4,A)') 1.2345, "z"
+ if (s .ne. '12.345E-01z') call abort
+ ! E format, negative scale factor
+ s = x
+ write (s, '(-2PE10.4,A)') 1.25, "z"
+ if (s .ne. '0.0013E+03z') call abort
end
Index: libgfortran/io/format.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/libgfortran/io/format.c,v
retrieving revision 1.5
diff -u -p -r1.5 format.c
--- libgfortran/io/format.c 21 May 2004 21:37:25 -0000 1.5
+++ libgfortran/io/format.c 2 Sep 2004 00:43:21 -0000
@@ -501,6 +501,7 @@ format_item:
p_descriptor:
get_fnode (&head, &tail, FMT_P);
tail->u.k = value;
+ tail->repeat = 1;
t = format_lex ();
if (t == FMT_F || t == FMT_EN || t == FMT_ES || t == FMT_D
Index: libgfortran/io/write.c
===================================================================
RCS file: /var/cvsroot/gcc-cvs/gcc/libgfortran/io/write.c,v
retrieving revision 1.12
diff -u -p -r1.12 write.c
--- libgfortran/io/write.c 28 Aug 2004 19:48:02 -0000 1.12
+++ libgfortran/io/write.c 2 Sep 2004 01:00:13 -0000
@@ -307,7 +307,8 @@ output_float (fnode *f, double value, in
edigits = 2;
}
- if (FMT_F || FMT_ES)
+ if (ft == FMT_F || ft == FMT_EN
+ || ((ft == FMT_D || ft == FMT_E) && g.scale_factor != 0))
{
/* Always convert at full precision to avoid double rounding. */
ndigits = 27 - edigits;
@@ -368,18 +369,26 @@ output_float (fnode *f, double value, in
case FMT_E:
case FMT_D:
i = g.scale_factor;
+ e -= i;
if (i < 0)
{
nbefore = 0;
nzero = -i;
nafter = d + i;
}
- else
+ else if (i > 0)
{
nbefore = i;
nzero = 0;
- nafter = d - i;
+ nafter = (d - i) + 1;
}
+ else /* i == 0 */
+ {
+ nbefore = 0;
+ nzero = 0;
+ nafter = d;
+ }
+
if (ft = FMT_E)
expchar = 'E';
else