+2019-05-22 Jeff Law <law@redhat.com>
+ Mark Eggleston <mark.eggleston@codethink.com>
+
+ PR fortran/89100
+ * gfortran.texi: Add Default widths for F, G and I format
+ descriptors to Extensions section.
+ * invoke.texi: Add -fdec-format-defaults
+ * io.c (check_format): Use default widths for i, f and g when
+ flag_dec_format_defaults is enabled.
+ * lang.opt: Add new option.
+ * options.c (set_dec_flags): Add SET_BITFLAG for
+ flag_dec_format_defaults.
+
2019-05-21 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/90038
* X format descriptor without count field::
* Commas in FORMAT specifications::
* Missing period in FORMAT specifications::
+* Default widths for F@comma{} G and I format descriptors::
* I/O item lists::
* @code{Q} exponent-letter::
* BOZ literal constants::
10 FORMAT ('F4')
@end smallexample
+@node Default widths for F@comma{} G and I format descriptors
+@subsection Default widths for @code{F}, @code{G} and @code{I} format descriptors
+
+To support legacy codes, GNU Fortran allows width to be omitted from format
+specifications if and only if @option{-fdec-format-defaults} is given on the
+command line. Default widths will be used. This is considered non-conforming
+code and is discouraged.
+
+@smallexample
+ REAL :: value1
+ INTEGER :: value2
+ WRITE(*,10) value1, value1, value2
+10 FORMAT ('F, G, I')
+@end smallexample
+
+
@node I/O item lists
@subsection I/O item lists
@cindex I/O item lists
@item Fortran Language Options
@xref{Fortran Dialect Options,,Options controlling Fortran dialect}.
@gccoptlist{-fall-intrinsics -fbackslash -fcray-pointer -fd-lines-as-code @gol
--fd-lines-as-comments @gol
--fdec -fdec-structure -fdec-intrinsic-ints -fdec-static -fdec-math @gol
--fdec-include -fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 @gol
--fdefault-real-10 -fdefault-real-16 -fdollar-ok -ffixed-line-length-@var{n} @gol
--ffixed-line-length-none -fpad-source -ffree-form -ffree-line-length-@var{n} @gol
--ffree-line-length-none -fimplicit-none -finteger-4-integer-8 @gol
--fmax-identifier-length -fmodule-private -ffixed-form -fno-range-check @gol
--fopenacc -fopenmp -freal-4-real-10 -freal-4-real-16 -freal-4-real-8 @gol
--freal-8-real-10 -freal-8-real-16 -freal-8-real-4 -std=@var{std}
--ftest-forall-temp
+-fd-lines-as-comments -fdec -fdec-structure -fdec-intrinsic-ints @gol
+-fdec-static -fdec-math -fdec-include -fdec-format-defaults @gol
+-fdefault-double-8 -fdefault-integer-8 -fdefault-real-8 -fdefault-real-10 @gol
+-fdefault-real-16 -fdollar-ok -ffixed-line-length-@var{n} @gol
+-ffixed-line-length-none -fpad-source -ffree-form @gol
+-ffree-line-length-@var{n} -ffree-line-length-none @gol
+-fimplicit-none -finteger-4-integer-8 -fmax-identifier-length @gol
+-fmodule-private -ffixed-form -fno-range-check -fopenacc -fopenmp @gol
+-freal-4-real-10 -freal-4-real-16 -freal-4-real-8 -freal-8-real-10 @gol
+-freal-8-real-16 -freal-8-real-4 -std=@var{std} -ftest-forall-temp
}
@item Preprocessing Options
INCLUDE line. When parsed as INCLUDE statement, INCLUDE does not have to
be on a single line and can use line continuations.
+@item -fdec-format-defaults
+@opindex @code{fdec-format-defaults}
+Enable format specifiers F, G and I to be used without width specifiers,
+default widths will be used instead.
+
@item -fdollar-ok
@opindex @code{fdollar-ok}
@cindex @code{$}
if (u != FMT_POSINT)
{
+ if (flag_dec_format_defaults)
+ {
+ /* Assume a default width based on the variable size. */
+ saved_token = u;
+ break;
+ }
+
format_locus.nextc += format_string_pos;
gfc_error ("Positive width required in format "
"specifier %s at %L", token_to_string (t),
goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
+ if (flag_dec_format_defaults)
+ {
+ /* Assume the default width is expected here and continue lexing. */
+ value = 0; /* It doesn't matter what we set the value to here. */
+ saved_token = t;
+ break;
+ }
error = nonneg_required;
goto syntax;
}
goto fail;
if (t != FMT_ZERO && t != FMT_POSINT)
{
- error = nonneg_required;
- goto syntax;
+ if (flag_dec_format_defaults)
+ {
+ /* Assume the default width is expected here and continue lexing. */
+ value = 0; /* It doesn't matter what we set the value to here. */
+ saved_token = t;
+ }
+ else
+ {
+ error = nonneg_required;
+ goto syntax;
+ }
}
else if (is_input && t == FMT_ZERO)
{
}
/* See if we want to use defaults for missing exponents in real transfers
- and other DEC runtime extensions. */
- if (flag_dec)
+ and other DEC runtime extensions. */
+ if (flag_dec_format_defaults)
dt->dec_ext = 1;
/* A full IO statement has been matched. Check the constraints. spec_end is
Fortran Var(flag_dec_include)
Enable legacy parsing of INCLUDE as statement.
+fdec-format-defaults
+Fortran Var(flag_dec_format_defaults)
+Enable default widths for i, f and g format specifiers.
+
fdec-intrinsic-ints
Fortran Var(flag_dec_intrinsic_ints)
Enable kind-specific variants of integer intrinsic functions.
SET_BITFLAG (flag_dec_static, value, value);
SET_BITFLAG (flag_dec_math, value, value);
SET_BITFLAG (flag_dec_include, value, value);
+ SET_BITFLAG (flag_dec_format_defaults, value, value);
}
/* Finalize DEC flags. */
+2019-05-22 Mark Eggleston <mark.eggleston@codethink.com>
+
+ PR fortran/89100
+ * gfortran.dg/fmt_f_default_field_width_1.f90: New test.
+ * gfortran.dg/fmt_f_default_field_width_2.f90: New test.
+ * gfortran.dg/fmt_f_default_field_width_3.f90: New test.
+ * gfortran.dg/fmt_g_default_field_width_1.f90: New test.
+ * gfortran.dg/fmt_g_default_field_width_2.f90: New test.
+ * gfortran.dg/fmt_g_default_field_width_3.f90: New test.
+ * gfortran.dg/fmt_i_default_field_width_1.f90: New test.
+ * gfortran.dg/fmt_i_default_field_width_2.f90: New test.
+ * gfortran.dg/fmt_i_default_field_width_3.f90: New test.
+
2019-05-22 Martin Liska <mliska@suse.cz>
PR testsuite/90564
--- /dev/null
+! { dg-do run }
+! { dg-options -fdec }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+
+program test
+ character(50) :: buffer
+
+ real(4) :: real_4
+ real(8) :: real_8
+ real(16) :: real_16
+ integer :: len
+ character(*), parameter :: fmt = "(A, F, A)"
+
+ real_4 = 4.18
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.1799998:") stop 1
+
+ real_4 = 0.00000018
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.0000002:") stop 2
+
+ real_8 = 4.18
+ write(buffer, fmt) ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) stop 3
+
+ real_16 = 4.18
+ write(buffer, fmt) ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) stop 4
+end
--- /dev/null
+! { dg-do run }
+! { dg-options -fdec-format-defaults }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fdec-format-defaults
+!
+
+program test
+ character(50) :: buffer
+
+ real(4) :: real_4
+ real(8) :: real_8
+ real(16) :: real_16
+ integer :: len
+ character(*), parameter :: fmt = "(A, F, A)"
+
+ real_4 = 4.18
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.1799998:") stop 1
+
+ real_4 = 0.00000018
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.0000002:") stop 2
+
+ real_8 = 4.18
+ write(buffer, fmt) ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) stop 3
+
+ real_16 = 4.18
+ write(buffer, fmt) ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) stop 4
+end
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-format-defaults" }
+!
+! Test case for the default field widths not enabled.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fno-dec-format-defaults
+!
+
+program test
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+ character(*), parameter :: fmt = "(A, F, A)"
+
+ real_4 = 4.18
+ write(buffer, fmt) ':',real_4,':' ! { dg-error "Nonnegative width required" }
+
+ real_4 = 0.00000018
+ write(buffer, fmt) ':',real_4,':' ! { dg-error "Nonnegative width required" }
+
+ real_8 = 4.18
+ write(buffer, fmt) ':',real_8,':' ! { dg-error "Nonnegative width required" }
+
+ real_16 = 4.18
+ write(buffer, fmt) ':',real_16,':' ! { dg-error "Nonnegative width required" }
+end
--- /dev/null
+! { dg-do run }
+! { dg-options -fdec }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+
+program test
+ character(50) :: buffer
+
+ real(4) :: real_4
+ real(8) :: real_8
+ real(16) :: real_16
+ integer :: len
+ character(*), parameter :: fmt = "(A, G, A)"
+
+ real_4 = 4.18
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.180000 :") stop 1
+
+ real_4 = 0.00000018
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E-06:") stop 2
+
+ real_4 = 18000000.4
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E+08:") stop 3
+
+ real_8 = 4.18
+ write(buffer, fmt) ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) stop 4
+
+ real_16 = 4.18
+ write(buffer, fmt) ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) stop 5
+end
--- /dev/null
+! { dg-do run }
+! { dg-options -fdec-format-defaults }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fdec-format-defaults
+!
+
+program test
+ character(50) :: buffer
+
+ real(4) :: real_4
+ real(8) :: real_8
+ real(16) :: real_16
+ integer :: len
+ character(*), parameter :: fmt = "(A, G, A)"
+
+ real_4 = 4.18
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.180000 :") stop 1
+
+ real_4 = 0.00000018
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E-06:") stop 2
+
+ real_4 = 18000000.4
+ write(buffer, fmt) ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E+08:") stop 3
+
+ real_8 = 4.18
+ write(buffer, fmt) ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) stop 4
+
+ real_16 = 4.18
+ write(buffer, fmt) ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) stop 5
+end
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-format-defaults" }
+!
+! Test case for the default field widths not enabled.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fno-dec-format-defaults
+!
+
+program test
+ character(50) :: buffer
+
+ real(4) :: real_4
+ real(8) :: real_8
+ real(16) :: real_16
+ integer :: len
+ character(*), parameter :: fmt = "(A, G, A)"
+
+ real_4 = 4.18
+ write(buffer, fmt) ':',real_4,':' ! { dg-error "Positive width required" }
+
+ real_4 = 0.00000018
+ write(buffer, fmt) ':',real_4,':' ! { dg-error "Positive width required" }
+
+ real_4 = 18000000.4
+ write(buffer, fmt) ':',real_4,':' ! { dg-error "Positive width required" }
+
+ real_8 = 4.18
+ write(buffer, fmt) ':',real_8,':' ! { dg-error "Positive width required" }
+
+ real_16 = 4.18
+ write(buffer, fmt) ':',real_16,':' ! { dg-error "Positive width required" }
+end
--- /dev/null
+! { dg-do run }
+! { dg-options -fdec }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+
+program test
+ character(50) :: buffer
+ character(1) :: colon
+
+ integer(2) :: integer_2
+ integer(4) :: integer_4
+ integer(8) :: integer_8
+ character(*), parameter :: fmt = "(A, I, A)"
+
+ write(buffer, fmt) ':',12340,':'
+ print *,buffer
+ if (buffer.ne.": 12340:") stop 1
+
+ read(buffer, "(1A, I, 1A)") colon, integer_4, colon
+ if ((integer_4.ne.12340).or.(colon.ne.":")) stop 2
+
+ integer_2 = -99
+ write(buffer, fmt) ':',integer_2,':'
+ print *,buffer
+ if (buffer.ne.": -99:") stop 3
+
+ integer_8 = -11112222
+ write(buffer, fmt) ':',integer_8,':'
+ print *,buffer
+ if (buffer.ne.": -11112222:") stop 4
+
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
+ integer_2 = 789
+ buffer = '0000000789'
+ read(buffer, '(I)') integer_2
+ if (integer_2.ne.0) stop 5
+end
--- /dev/null
+! { dg-do run }
+! { dg-options -fdec-format-defaults }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fdec-format-defaults
+!
+
+program test
+ character(50) :: buffer
+ character(1) :: colon
+
+ integer(2) :: integer_2
+ integer(4) :: integer_4
+ integer(8) :: integer_8
+ character(*), parameter :: fmt = "(A, I, A)"
+
+ write(buffer, fmt) ':',12340,':'
+ print *,buffer
+ if (buffer.ne.": 12340:") stop 1
+
+ read(buffer, '(A1, I, A1)') colon, integer_4, colon
+ if ((integer_4.ne.12340).or.(colon.ne.":")) stop 2
+
+ integer_2 = -99
+ write(buffer, fmt) ':',integer_2,':'
+ print *,buffer
+ if (buffer.ne.": -99:") stop 3
+
+ integer_8 = -11112222
+ write(buffer, fmt) ':',integer_8,':'
+ print *,buffer
+ if (buffer.ne.": -11112222:") stop 4
+
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
+ integer_2 = 789
+ buffer = '0000000789'
+ read(buffer, '(I)') integer_2
+ if (integer_2.ne.0) stop 5
+end
--- /dev/null
+! { dg-do compile }
+! { dg-options "-fdec -fno-dec-format-defaults" }
+!
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
+!
+! This feature is not part of any Fortran standard, but it is supported by the
+! Oracle Fortran compiler and others.
+!
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
+! use of -fdec-format-defaults
+!
+
+program test
+ character(50) :: buffer
+ character(1) :: colon
+
+ integer(2) :: integer_2
+ integer(4) :: integer_4
+ integer(8) :: integer_8
+ character(*), parameter :: fmt = "(A, I, A)"
+
+ write(buffer, fmt) ':',12340,':' ! { dg-error "Nonnegative width required" }
+
+ read(buffer, '(A1, I, A1)') colon, integer_4, colon ! { dg-error "Nonnegative width required" }
+ if (integer_4.ne.12340) stop 2
+
+ integer_2 = -99
+ write(buffer, fmt) ':',integer_2,':' ! { dg-error "Nonnegative width required" }
+
+ integer_8 = -11112222
+ write(buffer, fmt) ':',integer_8,':' ! { dg-error "Nonnegative width required" }
+
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
+ integer_2 = 789
+ buffer = '0000000789'
+ read(buffer, '(I)') integer_2 ! { dg-error "Nonnegative width required" }
+end
+2019-05-22 Jeff Law <law@redhat.com>
+
+ PR fortran/89100
+ * io/format.c (parse_format_list): set default width when the
+ IOPARM_DT_DEC_EXT flag is set for i, f and g.
+ * io/io.h: add default_width_for_integer, default_width_for_float
+ and default_precision_for_float.
+ * io/write.c (write_boz): extra parameter giving length of data
+ corresponding to the type's kind.
+ (write_b): pass data length as extra parameter in calls to
+ write_boz.
+ (write_o): pass data length as extra parameter in calls to
+ write_boz.
+ (write_z): pass data length as extra parameter in calls to
+ write_boz.
+ (size_from_kind): also set size is default width is set.
+ * io/write_float.def (build_float_string): new paramter inserted
+ before result parameter. If default width use values passed
+ instead of the values in fnode.
+ (FORMAT_FLOAT): macro modified to check for default width and
+ calls to build_float_string to pass in default width.
+ (get_float_string): set width and precision to defaults when
+ needed.
+
2019-05-19 Janne Blomqvist <jb@gcc.gnu.org>
PR libfortran/90038
*seen_dd = true;
if (u != FMT_POSINT && u != FMT_ZERO)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.real.w = DEFAULT_WIDTH;
+ tail->u.real.d = 0;
+ tail->u.real.e = -1;
+ fmt->saved_token = u;
+ break;
+ }
fmt->error = nonneg_required;
goto finished;
}
}
+ else if (u == FMT_ZERO)
+ {
+ fmt->error = posint_required;
+ goto finished;
+ }
else if (u != FMT_POSINT)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.real.w = DEFAULT_WIDTH;
+ tail->u.real.d = 0;
+ tail->u.real.e = -1;
+ fmt->saved_token = u;
+ break;
+ }
fmt->error = posint_required;
goto finished;
}
{
if (t != FMT_POSINT)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.integer.w = DEFAULT_WIDTH;
+ tail->u.integer.m = -1;
+ fmt->saved_token = t;
+ break;
+ }
fmt->error = posint_required;
goto finished;
}
{
if (t != FMT_ZERO && t != FMT_POSINT)
{
+ if (dtp->common.flags & IOPARM_DT_DEC_EXT)
+ {
+ tail->u.integer.w = DEFAULT_WIDTH;
+ tail->u.integer.m = -1;
+ fmt->saved_token = t;
+ break;
+ }
fmt->error = nonneg_required;
goto finished;
}
*p++ = c;
}
+/* Used in width fields to indicate that the default should be used */
+#define DEFAULT_WIDTH -1
+
+/* Defaults for certain format field descriptors. These are decided based on
+ * the type of the value being formatted.
+ *
+ * The behaviour here is modelled on the Oracle Fortran compiler. At the time
+ * of writing, the details were available at this URL:
+ *
+ * https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnc3/index.html#z4000743746d
+ */
+
+static inline int
+default_width_for_integer (int kind)
+{
+ switch (kind)
+ {
+ case 1:
+ case 2: return 7;
+ case 4: return 12;
+ case 8: return 23;
+ case 16: return 44;
+ default: return 0;
+ }
+}
+
+static inline int
+default_width_for_float (int kind)
+{
+ switch (kind)
+ {
+ case 4: return 15;
+ case 8: return 25;
+ case 16: return 42;
+ default: return 0;
+ }
+}
+
+static inline int
+default_precision_for_float (int kind)
+{
+ switch (kind)
+ {
+ case 4: return 7;
+ case 8: return 16;
+ case 16: return 33;
+ default: return 0;
+ }
+}
+
#endif
extern void
w = f->u.w;
+ /* This is a legacy extension, and the frontend will only allow such cases
+ * through when -fdec-format-defaults is passed.
+ */
+ if (w == DEFAULT_WIDTH)
+ w = default_width_for_integer (length);
+
p = read_block_form (dtp, &w);
if (p == NULL)
p[wlen - 1] = (n) ? 'T' : 'F';
}
-
static void
-write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
+write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n, int len)
{
int w, m, digits, nzero, nblank;
char *p;
/* Select a width if none was specified. The idea here is to always
print something. */
+ if (w == DEFAULT_WIDTH)
+ w = default_width_for_integer (len);
+
if (w == 0)
w = ((digits < m) ? m : digits);
/* Select a width if none was specified. The idea here is to always
print something. */
+ if (w == DEFAULT_WIDTH)
+ w = default_width_for_integer (len);
if (w == 0)
w = ((digits < m) ? m : digits) + nsign;
if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
{
p = btoa_big (source, itoa_buf, len, &n);
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
else
{
n = extract_uint (source, len);
p = btoa (n, itoa_buf, sizeof (itoa_buf));
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
}
if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
{
p = otoa_big (source, itoa_buf, len, &n);
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
else
{
n = extract_uint (source, len);
p = otoa (n, itoa_buf, sizeof (itoa_buf));
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
}
if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
{
p = ztoa_big (source, itoa_buf, len, &n);
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
else
{
n = extract_uint (source, len);
p = gfc_xtoa (n, itoa_buf, sizeof (itoa_buf));
- write_boz (dtp, f, p, n);
+ write_boz (dtp, f, p, n, len);
}
}
{
int size;
- if (f->format == FMT_F && f->u.real.w == 0)
+ if ((f->format == FMT_F && f->u.real.w == 0) || f->u.real.w == DEFAULT_WIDTH)
{
switch (kind)
{
static void
build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
size_t size, int nprinted, int precision, int sign_bit,
- bool zero_flag, int npad, char *result, size_t *len)
+ bool zero_flag, int npad, int default_width, char *result,
+ size_t *len)
{
char *put;
char *digits;
sign_t sign;
ft = f->format;
- w = f->u.real.w;
- d = f->u.real.d;
+ if (f->u.real.w == DEFAULT_WIDTH)
+ /* This codepath can only be reached with -fdec-format-defaults. */
+ {
+ w = default_width;
+ d = precision;
+ }
+ else
+ {
+ w = f->u.real.w;
+ d = f->u.real.d;
+ }
p = dtp->u.p.scale_factor;
*len = 0;
int save_scale_factor;\
volatile GFC_REAL_ ## x temp;\
save_scale_factor = dtp->u.p.scale_factor;\
+ if (w == DEFAULT_WIDTH)\
+ {\
+ w = default_width;\
+ d = precision;\
+ }\
switch (dtp->u.p.current_unit->round_status)\
{\
case ROUND_ZERO:\
nprinted = FDTOA(y,precision,m);\
}\
build_float_string (dtp, &newf, buffer, size, nprinted, precision,\
- sign_bit, zero_flag, npad, result, res_len);\
+ sign_bit, zero_flag, npad, default_width,\
+ result, res_len);\
dtp->u.p.scale_factor = save_scale_factor;\
}\
else\
else\
nprinted = DTOA(y,precision,m);\
build_float_string (dtp, f, buffer, size, nprinted, precision,\
- sign_bit, zero_flag, npad, result, res_len);\
+ sign_bit, zero_flag, npad, default_width,\
+ result, res_len);\
}\
}\
{
int sign_bit, nprinted;
bool zero_flag;
+ int default_width = 0;
+
+ if (f->u.real.w == DEFAULT_WIDTH)
+ /* This codepath can only be reached with -fdec-format-defaults. The default
+ * values are based on those used in the Oracle Fortran compiler.
+ */
+ {
+ default_width = default_width_for_float (kind);
+ precision = default_precision_for_float (kind);
+ }
switch (kind)
{
projects / gcc.git / commitdiff