Codethink has several more changes that improve gfortran's ability to
handle legacy codebases, particularly those which rely on DEC
extensions. Most are strictly compiler side issues. However, one
touches on the runtime.
Specifically, as an extension, DEC Fortran allows omitting the width in
format statement field descriptors. The runtime then selects a default
width based on the data type.
This is documented in the old manuals from DEC and I've found
essentially the same documentation in Oracle/Sun's current documentation
as well as old MIPS documentation. I have a high degree of confidence
it exists in IBM's Fortran compilers as well. In contrast Intel & PCG's
Fortran compilers do not seem to support this extension.
Oracle's docs can be found here (Defaults for w, d, and e):
https://docs.oracle.com/cd/E19957-01/805-4939/z40007437a2e/index.html
Another example:
http://wwwteor.mi.infn.it/~vicini/decfortman.html#77
Because this is a case where where a compile-time flag needs to affect
the runtime, we need to communicate to the runtime that the magic
compile-time flag is on.
We have two general approaches for this kind of communication. One is
to set a mask within the DT_PARM which gets passed into the runtime at
the call site. The other is to marshall the flags in
gfortran_set{args,options} on a global basis.
Jakub has indicated the former approach is generally preferred and it
matches what was recently done for the default exponent handling. So
that's what this patch does under the control of -fdec-format-defaults
I am _not_ proposing this patch for inclusion into gcc-8. I'll propose
it for gcc-9. However, I would like to get the bit within the DT_PARM
bitmask reserved at this time for this purpose. I'd like to use bit
#28. That leaves two free bits remaining. I'm not aware of any pending
need to allocate either of those two free bits.
If we can agree to allocate bit #28 for this purpose I'll propose a
gcc-8 patch which notes the bit's reservation as a comment.
Thoughts?
Jeff
* gfortran.h (struct gfc_dt): Add DEFAULT_WIDTH field.
* io.c (check_format): For -fdec-format-defaults, allow
empty width field descriptor.
(match_io): Set dt->default_width as necessary.
* ioparm.h (IOPARM_dt_default_width): Define.
* lang.opt: Add -fdec-format-defaults.
* trans-io.c (build_dt): Set IOPARM_dt_default_width as
necessary.
* gfortran.dg/fmt_f_default_field_width.f90: New test.
* gfortran.dg/fmt_g_default_field_width.f90: New test.
* gfortran.dg/fmt_i_default_field_width.f90: New test.
* io/format.c (parse_format_list): Conditionally handle
defaulted widths.
* io/io.h (IOPARM_DT_DEFAULT_WIDTH): Define.
(default_width_for_integer): New function.
(default_width_for_float): New function.
(default_precision_for_float): New function.
* io/read.c (read_decimal): Handle case where width is
the defaulted.
* io/write.c (write_boz): Accept new LEN paramter. Use it
to determine the default width as needed.
(write_b, write_o, write_z): Pass LEN argument to write_boz.
(write_decimal): Use LEN to determine default width as needed.
(size_from_kind): Handle defaulted widths as well.
* write_float.def (build_float_string): Accept new DEFAULT_WIDTH
parameter. Use it as needed.
(FORMAT_FLOAT): Pass new argument to build_float_string.
Handle defaulted widths as needed.
(get_float_string): Similarly.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2b9eb23..922558a 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2440,6 +2440,7 @@ typedef struct
*id, *pos, *asynchronous, *blank, *decimal, *delim, *pad, *round,
*sign, *extra_comma, *dt_io_kind, *udtio;
char default_exp;
+ char default_width;
gfc_symbol *namelist;
/* A format_label of `format_asterisk' indicates the "*" format */
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index ce4eef3..68da85d 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -912,6 +912,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),
@@ -1036,6 +1043,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;
}
@@ -1105,8 +1119,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)
{
@@ -4263,6 +4286,11 @@ get_io_list:
if (flag_dec)
dt->default_exp = 1;
+ /* If DEC compatibility is enabled, then enable default widths for format
+ specifiers in the runtime. */
+ if (flag_dec || flag_dec_format_defaults)
+ dt->default_width = 1;
+
/* A full IO statement has been matched. Check the constraints. spec_end is
supplied for cases where no locus is supplied. */
m = check_io_constraints (k, dt, io_code, &spec_end);
diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def
index b9dc58f..7d77d19 100644
--- a/gcc/fortran/ioparm.def
+++ b/gcc/fortran/ioparm.def
@@ -119,4 +119,5 @@ IOPARM (dt, sign, 1 << 24, char1)
#define IOPARM_dt_f2003 (1 << 25)
#define IOPARM_dt_dtio (1 << 26)
#define IOPARM_dt_default_exp (1 << 27)
+#define IOPARM_dt_default_width (1 << 28)
IOPARM (dt, u, 0, pad)
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 52ac20c..605fd87 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -444,6 +444,11 @@ fdec-pad-with-spaces
Fortran Var(flag_dec_pad_with_spaces)
For character to integer conversions, use spaces for the pad rather than NUL.
+fdec-format-defaults
+Fortran Var(flag_dec_format_defaults)
+Allow omitting the width specifier in a FORMAT statement. A default width will
+be selected by the runtime based on the type of the argument.
+
fdec-intrinsic-ints
Fortran Var(flag_dec_intrinsic_ints)
Enable kind-specific variants of integer intrinsic functions.
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 9058712..967de0d 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -1961,6 +1961,9 @@ build_dt (tree function, gfc_code * code)
if (dt->default_exp)
mask |= IOPARM_dt_default_exp;
+ if (dt->default_width)
+ mask |= IOPARM_dt_default_width;
+
if (dt->namelist)
{
if (dt->format_expr || dt->format_label)
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90
b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90
new file mode 100644
index 0000000..d233cea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90
@@ -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.
+!
+! libgfortran uses printf() internally to implement FORMAT. If you print float
+! values to a higher precision than the type can actually store, the results
+! are implementation dependent: some platforms print zeros, others print random
+! numbers. Don't depend on this behaviour in tests because they will not be
+! portable.
+
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+
+ real_4 = 4.18
+ write(buffer, '(A, F, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.1799998:") call abort
+
+ real_4 = 0.00000018
+ write(buffer, '(A, F, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.0000002:") call abort
+
+ real_8 = 4.18
+ write(buffer, '(A, F, A)') ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) call abort
+
+ real_16 = 4.18
+ write(buffer, '(A, F, A)') ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90
b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90
new file mode 100644
index 0000000..65784f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90
@@ -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.
+!
+! libgfortran uses printf() internally to implement FORMAT. If you print float
+! values to a higher precision than the type can actually store, the results
+! are implementation dependent: some platforms print zeros, others print random
+! numbers. Don't depend on this behaviour in tests because they will not be
+! portable.
+
+ character(50) :: buffer
+
+ real*4 :: real_4
+ real*8 :: real_8
+ real*16 :: real_16
+ integer :: len
+
+ real_4 = 4.18
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 4.180000 :") call abort
+
+ real_4 = 0.00000018
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E-06:") call abort
+
+ real_4 = 18000000.4
+ write(buffer, '(A, G, A)') ':',real_4,':'
+ print *,buffer
+ if (buffer.ne.": 0.1800000E+08:") call abort
+
+ real_8 = 4.18
+ write(buffer, '(A, G, A)') ':',real_8,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 27) call abort
+
+ real_16 = 4.18
+ write(buffer, '(A, G, A)') ':',real_16,':'
+ print *,buffer
+ len = len_trim(buffer)
+ if (len /= 44) call abort
+end
diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90
b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90
new file mode 100644
index 0000000..2a5c633
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90
@@ -0,0 +1,38 @@
+! { 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.
+
+ character(50) :: buffer
+ character(1) :: colon
+
+ integer*2 :: integer_2
+ integer*4 :: integer_4
+ integer*8 :: integer_8
+
+ write(buffer, '(A, I, A)') ':',12340,':'
+ print *,buffer
+ if (buffer.ne.": 12340:") call abort
+
+ read(buffer, '(A1, I, A1)') colon, integer_4, colon
+ if (integer_4.ne.12340) call abort
+
+ integer_2 = -99
+ write(buffer, '(A, I, A)') ':',integer_2,':'
+ print *,buffer
+ if (buffer.ne.": -99:") call abort
+
+ integer_8 = -11112222
+ write(buffer, '(A, I, A)') ':',integer_8,':'
+ print *,buffer
+ if (buffer.ne.": -11112222:") call abort
+
+! 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) call abort
+end
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index b4920aa..9bf690d 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -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_DEFAULT_WIDTH)
+ {
+ 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_DEFAULT_WIDTH)
+ {
+ 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_DEFAULT_WIDTH)
+ {
+ 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_DEFAULT_WIDTH)
+ {
+ tail->u.integer.w = DEFAULT_WIDTH;
+ tail->u.integer.m = -1;
+ fmt->saved_token = t;
+ break;
+ }
fmt->error = nonneg_required;
goto finished;
}
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 3c2a2ca..fd0d12f 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -443,6 +443,7 @@ st_parameter_inquire;
#define IOPARM_DT_HAS_F2003 (1 << 25)
#define IOPARM_DT_HAS_UDTIO (1 << 26)
#define IOPARM_DT_DEFAULT_EXP (1 << 27)
+#define IOPARM_DT_DEFAULT_WIDTH (1 << 28)
/* Internal use bit. */
#define IOPARM_DT_IONML_SET (1u << 31)
@@ -986,5 +987,55 @@ 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
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 87adfb8..a9d7733 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -633,6 +633,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)
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 50ea133..a74dd00 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -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);
}
}
@@ -1486,7 +1490,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)
{
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
index 177a568..31dd18b 100644
--- a/libgfortran/io/write_float.def
+++ b/libgfortran/io/write_float.def
@@ -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;
rchar = '5';
@@ -958,6 +968,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:\
@@ -1033,7 +1048,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\
@@ -1043,7 +1059,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);\
}\
}\
@@ -1057,6 +1074,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)
{
