+2008-09-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/37228
+ * io.c (check_format): Allow specifying precision with g0 format.
+
2008-09-02 Daniel Kraft <d@domob.eu>
* gfortran.h (struct gfc_namespace): New member `implicit_loc'.
" at %L");
const char *unexpected_end = _("Unexpected end of format string");
const char *zero_width = _("Zero width in format descriptor");
- const char *g0_precision = _("Specifying precision with G0 not allowed");
const char *error;
format_token t, u;
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 ();
+2008-09-01 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/37228
+ * gfortran.dg/fmt_g0_4.f08: Revised test.
+
2008-09-02 Daniel Kraft <d@domob.eu>
* gfortran.dg/abstract_type_1.f90: New test.
! { 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
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>
+
* runtime/error.c: Fix cast for printf.
2008-08-30 Jerry DeLisle <jvdelisle@gcc.gnu.org>
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)
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);
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;
if (is_stream_io (dtp))
{
const char crlf[] = "\r\n";
- int i, j, bytes;
+ int i, bytes;
gfc_char4_t *qq;
bytes = 0;
}
-/* 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;
}