mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2024-12-01 19:00:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

fortran/89100: Default widths with -fdec-format-defaults

Browse Source 
gcc/fortran ChangeLog:

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.


gcc/testsuite ChangeLog:

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.


libgfortran ChangeLog:

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.

From-SVN: r271511
This commit is contained in:
Janne Blomqvist 2019-05-22 14:56:01 +03:00
parent fa70c22141
commit 88a8126a90
22 changed files with 610 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -1,3 +1,16 @@
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

17
gcc/fortran/gfortran.texi
View File

@ -1576,6 +1576,7 @@ additional compatibility extensions along with those enabled by
* 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::
@ -1782,6 +1783,22 @@ discouraged.
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

25
gcc/fortran/invoke.texi
View File

@ -117,16 +117,16 @@ by type. Explanations are in the following sections.
@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
@ -283,6 +283,11 @@ Enable parsing of INCLUDE as a statement in addition to parsing it as
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{$}

31
gcc/fortran/io.c
View File

@ -903,6 +903,13 @@ data_desc:
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),
@ -1027,6 +1034,13 @@ data_desc:
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;
}
@ -1096,8 +1110,17 @@ data_desc:
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)
{
@ -4368,8 +4391,8 @@ get_io_list:
}
/* 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

4
gcc/fortran/lang.opt
View File

@ -452,6 +452,10 @@ fdec-include
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.

1
gcc/fortran/options.c
View File

@ -74,6 +74,7 @@ set_dec_flags (int value)
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. */

13
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,16 @@
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

40
gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90 Normal file
View File

@ -0,0 +1,40 @@
! { 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

43
gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90 Normal file
View File

@ -0,0 +1,43 @@
! { 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

30
gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90 Normal file
View File

@ -0,0 +1,30 @@
! { 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

45
gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90 Normal file
View File

@ -0,0 +1,45 @@
! { 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

48
gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90 Normal file
View File

@ -0,0 +1,48 @@
! { 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

33
gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90 Normal file
View File

@ -0,0 +1,33 @@
! { 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

40
gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90 Normal file
View File

@ -0,0 +1,40 @@
! { 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

44
gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90 Normal file
View File

@ -0,0 +1,44 @@
! { 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

37
gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90 Normal file
View File

@ -0,0 +1,37 @@
! { 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

24
libgfortran/ChangeLog
View File

@ -1,3 +1,27 @@
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

35
libgfortran/io/format.c
View File

@ -956,12 +956,33 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
*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;
}
@ -1100,6 +1121,13 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
{
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;
}
@ -1108,6 +1136,13 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
{
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;
}

50
libgfortran/io/io.h
View File

@ -1011,6 +1011,56 @@ memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
*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

6
libgfortran/io/read.c
View File

@ -635,6 +635,12 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
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)

22
libgfortran/io/write.c
View File

@ -685,9 +685,8 @@ write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len)
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;
@ -720,6 +719,9 @@ write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
/* 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);
@ -846,6 +848,8 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
/* 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;
@ -1206,13 +1210,13 @@ write_b (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
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);
}
}
@ -1227,13 +1231,13 @@ write_o (st_parameter_dt *dtp, const fnode *f, const char *source, int 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);
}
}
@ -1247,13 +1251,13 @@ write_z (st_parameter_dt *dtp, const fnode *f, const char *source, int 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);
}
}
@ -1491,7 +1495,7 @@ size_from_kind (st_parameter_dt *dtp, const fnode *f, int kind)
{
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)
{

37
libgfortran/io/write_float.def
View File

@ -113,7 +113,8 @@ determine_precision (st_parameter_dt * dtp, const fnode * f, int len)
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;
@ -132,8 +133,17 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
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;
@ -960,6 +970,11 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
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:\
@ -1035,7 +1050,8 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
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\
@ -1045,7 +1061,8 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
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);\
}\
}\
@ -1059,6 +1076,16 @@ get_float_string (st_parameter_dt *dtp, const fnode *f, const char *source,
{
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)
{