diff --git a/SOURCES/gcc8-libgfortran-default-values.patch b/SOURCES/gcc8-libgfortran-default-values.patch new file mode 100644 index 0000000..b070abe --- /dev/null +++ b/SOURCES/gcc8-libgfortran-default-values.patch @@ -0,0 +1,516 @@ +diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c +index d93dcfa..f47565c 100644 +--- a/gcc/fortran/io.c ++++ b/gcc/fortran/io.c +@@ -909,6 +909,13 @@ data_desc: + + if (u != FMT_POSINT) + { ++ if (flag_dec) ++ { ++ /* 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), +@@ -1030,6 +1037,13 @@ data_desc: + goto fail; + if (t != FMT_ZERO && t != FMT_POSINT) + { ++ if (flag_dec) ++ { ++ /* 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; + } +@@ -1099,8 +1113,17 @@ data_desc: + goto fail; + if (t != FMT_ZERO && t != FMT_POSINT) + { +- error = nonneg_required; +- goto syntax; ++ if (flag_dec) ++ { ++ /* 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) + { +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..b087b8f +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width.f90 +@@ -0,0 +1,43 @@ ++! { 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. ++! ++! 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..3d3a476 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width.f90 +@@ -0,0 +1,48 @@ ++! { 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. ++! ++! 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..ac4e165 +--- /dev/null ++++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width.f90 +@@ -0,0 +1,38 @@ ++! { 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. ++ ++ 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 c2abdd7..692b1ff 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_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; + } +@@ -1099,6 +1120,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; + } +@@ -1107,6 +1135,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; + } +diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h +index 5583183..d1d08e8 100644 +--- a/libgfortran/io/io.h ++++ b/libgfortran/io/io.h +@@ -981,5 +981,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 2c9de48..e911e35 100644 +--- a/libgfortran/io/read.c ++++ b/libgfortran/io/read.c +@@ -629,6 +629,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 a7307a8..c8e52fb 100644 +--- a/libgfortran/io/write.c ++++ b/libgfortran/io/write.c +@@ -684,9 +684,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; +@@ -719,6 +718,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); + +@@ -845,6 +847,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; +@@ -1187,13 +1191,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); + } + } + +@@ -1208,13 +1212,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); + } + } + +@@ -1228,13 +1232,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); + } + } + +@@ -1504,7 +1508,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 7f0aa1d..73dc910 100644 +--- a/libgfortran/io/write_float.def ++++ b/libgfortran/io/write_float.def +@@ -113,7 +113,8 @@ determine_precision (st_parameter_dt * d + 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 + 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; + +@@ -959,6 +969,11 @@ determine_en_precision (st_parameter_dt + 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:\ +@@ -1034,7 +1049,8 @@ determine_en_precision (st_parameter_dt + 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\ +@@ -1044,7 +1060,8 @@ determine_en_precision (st_parameter_dt + 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);\ + }\ + }\ + +@@ -1058,6 +1075,16 @@ get_float_string (st_parameter_dt *dtp, + { + 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) + { diff --git a/SPECS/gcc.spec b/SPECS/gcc.spec index e20b644..17d059b 100644 --- a/SPECS/gcc.spec +++ b/SPECS/gcc.spec @@ -104,7 +104,7 @@ Summary: Various compilers (C, C++, Objective-C, ...) Name: gcc Version: %{gcc_version} -Release: %{gcc_release}%{?dist}.alma +Release: %{gcc_release}.1%{?dist}.alma # libgcc, libgfortran, libgomp, libstdc++ and crtstuff have # GCC Runtime Exception. License: GPLv3+ and GPLv3+ with exceptions and GPLv2+ with exceptions and LGPLv2+ and BSD @@ -284,6 +284,7 @@ Patch23: gcc8-pr96796.patch Patch24: gcc8-pch-tweaks.patch Patch25: gcc8-aarch64-mtune-neoverse-512tvb.patch Patch26: gcc8-rh2028609.patch +Patch27: gcc8-libgfortran-default-values.patch Patch30: gcc8-rh1668903-1.patch Patch31: gcc8-rh1668903-2.patch @@ -871,6 +872,7 @@ to NVidia PTX capable devices if available. %patch24 -p1 -b .pch-tweaks~ %patch25 -p1 -b .neoverse~ %patch26 -p1 -b .rh2028609~ +%patch27 -p1 -b .libgfortran-default~ %patch30 -p0 -b .rh1668903-1~ %patch31 -p0 -b .rh1668903-2~ @@ -3188,6 +3190,9 @@ fi %endif %changelog +* Wed Apr 27 2022 Marek Polacek 8.5.0-10.1 +- backport Default widths with -fdec-format-defaults patch (#2079578) + * Thu Jan 27 2022 Marek Polacek 8.5.0-10 - fix typo in the cprop_hardreg patch (#2028609)