This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] PR37228 and 37301
- From: Jerry DeLisle <jvdelisle at verizon dot net>
- To: Fortran List <fortran at gcc dot gnu dot org>
- Cc: gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Mon, 01 Sep 2008 18:58:08 -0700
- Subject: [patch, fortran] PR37228 and 37301
This patch eliminates the unused variable in PR37301. (trivial)
This patch also modifies the behavior of g0 format editing to allow g0.d as
specified in the response to public comments on the draft F2008 standard.
"When used to specify the output of real or complex data, the
G0 and G0.<d> edit descriptors follow the rules for the
ES<w>.<d>E<e> edit descriptor. Reasonable processor-dependent
values of <w>, <d> (if not specified), and <e> are used with
each output value."
This is accomplished by allowing the .d specifier with g0 and then at run time,
when .d is detected, setting the default width and setting the precision
accordingly.
The patch includes a revised test case.
Regression tested on x86-64.
OK for trunk? Can someone commit for me since I will be offline for the next
several days on business travel.
Regards,
Jerry
2008-09-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/37228
* io.c (check_format): Allow specifying precision with g0 format.
2008-09-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/37301
PR libfortran/37228
* io/io.h (write_real_g0): Declare new function to handle g0.d format.
* io/transfer.c (formatted_transfer_scalar): Use new function.
* io/format.c (parse_format_list): Enable g0.d.
* io/write.c (write_a_char4): Delete unused var.
(set_fnode_default): New function to set the default fnode w, d, and e
factored from write_real. (write_real): Use new factored function.
(write_real_g0): New function that sets d to that passed by g0.d format
specifier and set format to ES. Default values for w and e are used
from the new function, set_fnode_default.
2008-09-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/37228
* gfortran.dg/fmt_g0_4.f08: Revised test.
Index: gcc/testsuite/gfortran.dg/fmt_g0_4.f08
===================================================================
--- gcc/testsuite/gfortran.dg/fmt_g0_4.f08 (revision 139804)
+++ gcc/testsuite/gfortran.dg/fmt_g0_4.f08 (working copy)
@@ -1,5 +1,15 @@
! { dg-do compile }
! { dg-options "-std=f2008" }
! PR36725 Compile time error for g0 edit descriptor
-print '(g0.9)', 0.1 ! { dg-error "Specifying precision" }
+character(30) :: line
+write(line, '(g0.3)') 0.1
+if (line.ne." 1.000E-01") call abort
+write(line, '(g0.9)') 1.0
+if (line.ne."1.000000000E+00") call abort
+write(line, '(g0.5)') 29.23
+if (line.ne." 2.92300E+01") call abort
+write(line, '(g0.8)') -28.4
+if (line.ne."-2.83999996E+01") call abort
+write(line, '(g0.8)') -0.0001
+if (line.ne."-9.99999975E-05") call abort
end
Index: gcc/fortran/io.c
===================================================================
--- gcc/fortran/io.c (revision 139804)
+++ gcc/fortran/io.c (working copy)
@@ -701,27 +701,25 @@ data_desc:
error = zero_width;
goto syntax;
}
-
if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: 'G0' in "
"format at %C") == FAILURE)
return FAILURE;
+ u = format_lex ();
+ if (u != FMT_PERIOD)
+ {
+ saved_token = u;
+ break;
+ }
u = format_lex ();
- if (u == FMT_PERIOD)
+ if (u == FMT_ERROR)
+ goto fail;
+ if (u != FMT_POSINT)
{
- error = g0_precision;
+ error = posint_required;
goto syntax;
}
- saved_token = u;
- goto between_desc;
- }
-
- if (u == FMT_ERROR)
- goto fail;
- if (u != FMT_POSINT)
- {
- error = posint_required;
- goto syntax;
+ break;
}
u = format_lex ();
Index: libgfortran/io/io.h
===================================================================
--- libgfortran/io/io.h (revision 139812)
+++ libgfortran/io/io.h (working copy)
@@ -940,6 +940,9 @@ internal_proto(write_o);
extern void write_real (st_parameter_dt *, const char *, int);
internal_proto(write_real);
+extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
+internal_proto(write_real_g0);
+
extern void write_x (st_parameter_dt *, int, int);
internal_proto(write_x);
Index: libgfortran/io/transfer.c
===================================================================
--- libgfortran/io/transfer.c (revision 139812)
+++ libgfortran/io/transfer.c (working copy)
@@ -1213,7 +1213,12 @@ formatted_transfer_scalar (st_parameter_
break;
case BT_REAL:
if (f->u.real.w == 0)
- write_real (dtp, p, kind);
+ {
+ if (f->u.real.d == 0)
+ write_real (dtp, p, kind);
+ else
+ write_real_g0 (dtp, p, kind, f->u.real.d);
+ }
else
write_d (dtp, f, p, kind);
break;
Index: libgfortran/io/format.c
===================================================================
--- libgfortran/io/format.c (revision 139812)
+++ libgfortran/io/format.c (working copy)
@@ -735,6 +735,20 @@ parse_format_list (st_parameter_dt *dtp)
goto finished;
}
tail->u.real.w = 0;
+ u = format_lex (fmt);
+ if (u != FMT_PERIOD)
+ {
+ fmt->saved_token = u;
+ break;
+ }
+
+ u = format_lex (fmt);
+ if (u != FMT_POSINT)
+ {
+ fmt->error = posint_required;
+ goto finished;
+ }
+ tail->u.real.d = fmt->value;
break;
}
if (t == FMT_F || dtp->u.p.mode == WRITING)
Index: libgfortran/io/write.c
===================================================================
--- libgfortran/io/write.c (revision 139813)
+++ libgfortran/io/write.c (working copy)
@@ -301,7 +301,7 @@ write_a_char4 (st_parameter_dt *dtp, con
if (is_stream_io (dtp))
{
const char crlf[] = "\r\n";
- int i, j, bytes;
+ int i, bytes;
gfc_char4_t *qq;
bytes = 0;
@@ -952,43 +952,64 @@ write_character (st_parameter_dt *dtp, c
}
-/* Output a real number with default format.
- This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8),
- 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */
+/* Set an fnode to default format. */
-void
-write_real (st_parameter_dt *dtp, const char *source, int length)
+static void
+set_fnode_default (st_parameter_dt *dtp, fnode *f, int length)
{
- fnode f ;
- int org_scale = dtp->u.p.scale_factor;
- f.format = FMT_G;
- dtp->u.p.scale_factor = 1;
+ f->format = FMT_G;
switch (length)
{
case 4:
- f.u.real.w = 15;
- f.u.real.d = 8;
- f.u.real.e = 2;
+ f->u.real.w = 15;
+ f->u.real.d = 8;
+ f->u.real.e = 2;
break;
case 8:
- f.u.real.w = 25;
- f.u.real.d = 17;
- f.u.real.e = 3;
+ f->u.real.w = 25;
+ f->u.real.d = 17;
+ f->u.real.e = 3;
break;
case 10:
- f.u.real.w = 29;
- f.u.real.d = 20;
- f.u.real.e = 4;
+ f->u.real.w = 29;
+ f->u.real.d = 20;
+ f->u.real.e = 4;
break;
case 16:
- f.u.real.w = 44;
- f.u.real.d = 35;
- f.u.real.e = 4;
+ f->u.real.w = 44;
+ f->u.real.d = 35;
+ f->u.real.e = 4;
break;
default:
internal_error (&dtp->common, "bad real kind");
break;
}
+}
+/* Output a real number with default format.
+ This is 1PG14.7E2 for REAL(4), 1PG23.15E3 for REAL(8),
+ 1PG28.19E4 for REAL(10) and 1PG43.34E4 for REAL(16). */
+
+void
+write_real (st_parameter_dt *dtp, const char *source, int length)
+{
+ fnode f ;
+ int org_scale = dtp->u.p.scale_factor;
+ dtp->u.p.scale_factor = 1;
+ set_fnode_default (dtp, &f, length);
+ write_float (dtp, &f, source , length);
+ dtp->u.p.scale_factor = org_scale;
+}
+
+
+void
+write_real_g0 (st_parameter_dt *dtp, const char *source, int length, int d)
+{
+ fnode f ;
+ int org_scale = dtp->u.p.scale_factor;
+ dtp->u.p.scale_factor = 1;
+ set_fnode_default (dtp, &f, length);
+ f.format = FMT_ES;
+ f.u.real.d = d;
write_float (dtp, &f, source , length);
dtp->u.p.scale_factor = org_scale;
}