Blame SOURCES/0001-Default-widths-for-i-f-and-g-format-specifiers-in-fo.patch

9805c9
From f3e3034684c7ac44a14c70d6a248d8acee303176 Mon Sep 17 00:00:00 2001
9805c9
From: law <law@138bc75d-0d04-0410-961f-82ee72b054a4>
9805c9
Date: Thu, 10 May 2018 11:48:34 +0100
9805c9
Subject: [PATCH 01/16] Default widths for i, f and g format specifiers in
9805c9
 format strings.
9805c9
9805c9
Enabled using -fdec.
9805c9
9805c9
The behaviour is modelled on the Oracle Fortran compiler. At the time
9805c9
of writing, the details were available at this URL:
9805c9
9805c9
  https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnc3/index.html#z4000743746d
9805c9
9805c9
Addition by Mark Eggleston <mark.eggleston@codethink.com>:
9805c9
9805c9
Use -fdec-format-defaults to enable this feature. Also enabled using -fdec.
9805c9
---
9805c9
 gcc/fortran/io.c                                   | 31 +++++++++++--
9805c9
 gcc/fortran/lang.opt                               |  4 ++
9805c9
 gcc/fortran/options.c                              |  1 +
9805c9
 .../gfortran.dg/fmt_f_default_field_width_1.f90    | 43 ++++++++++++++++++
9805c9
 .../gfortran.dg/fmt_f_default_field_width_2.f90    | 46 +++++++++++++++++++
9805c9
 .../gfortran.dg/fmt_f_default_field_width_3.f90    | 28 ++++++++++++
9805c9
 .../gfortran.dg/fmt_g_default_field_width_1.f90    | 48 ++++++++++++++++++++
9805c9
 .../gfortran.dg/fmt_g_default_field_width_2.f90    | 52 ++++++++++++++++++++++
9805c9
 .../gfortran.dg/fmt_g_default_field_width_3.f90    | 31 +++++++++++++
9805c9
 .../gfortran.dg/fmt_i_default_field_width_1.f90    | 38 ++++++++++++++++
9805c9
 .../gfortran.dg/fmt_i_default_field_width_2.f90    | 42 +++++++++++++++++
9805c9
 .../gfortran.dg/fmt_i_default_field_width_3.f90    | 35 +++++++++++++++
9805c9
 libgfortran/io/format.c                            | 35 +++++++++++++++
9805c9
 libgfortran/io/io.h                                | 50 +++++++++++++++++++++
9805c9
 libgfortran/io/read.c                              |  6 +++
9805c9
 libgfortran/io/write.c                             | 22 +++++----
9805c9
 libgfortran/io/write_float.def                     | 37 ++++++++++++---
9805c9
 17 files changed, 531 insertions(+), 18 deletions(-)
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90
9805c9
 create mode 100644 gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90
9805c9
9805c9
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
9805c9
index 9828897852a..57117579627 100644
9805c9
--- a/gcc/fortran/io.c
9805c9
+++ b/gcc/fortran/io.c
9805c9
@@ -903,6 +903,13 @@ data_desc:
9805c9
 
9805c9
       if (u != FMT_POSINT)
9805c9
 	{
9805c9
+	  if (flag_dec_format_defaults)
9805c9
+	    {
9805c9
+	      /* Assume a default width based on the variable size.  */
9805c9
+	      saved_token = u;
9805c9
+	      break;
9805c9
+	    }
9805c9
+
9805c9
 	  format_locus.nextc += format_string_pos;
9805c9
 	  gfc_error ("Positive width required in format "
9805c9
 			 "specifier %s at %L", token_to_string (t),
9805c9
@@ -1027,6 +1034,13 @@ data_desc:
9805c9
 	goto fail;
9805c9
       if (t != FMT_ZERO && t != FMT_POSINT)
9805c9
 	{
9805c9
+	  if (flag_dec_format_defaults)
9805c9
+	    {
9805c9
+	      /* Assume the default width is expected here and continue lexing.  */
9805c9
+	      value = 0; /* It doesn't matter what we set the value to here.  */
9805c9
+	      saved_token = t;
9805c9
+	      break;
9805c9
+	    }
9805c9
 	  error = nonneg_required;
9805c9
 	  goto syntax;
9805c9
 	}
9805c9
@@ -1096,8 +1110,17 @@ data_desc:
9805c9
 	goto fail;
9805c9
       if (t != FMT_ZERO && t != FMT_POSINT)
9805c9
 	{
9805c9
-	  error = nonneg_required;
9805c9
-	  goto syntax;
9805c9
+	  if (flag_dec_format_defaults)
9805c9
+	    {
9805c9
+	      /* Assume the default width is expected here and continue lexing.  */
9805c9
+	      value = 0; /* It doesn't matter what we set the value to here.  */
9805c9
+	      saved_token = t;
9805c9
+	    }
9805c9
+	  else
9805c9
+	    {
9805c9
+	      error = nonneg_required;
9805c9
+	      goto syntax;
9805c9
+	    }
9805c9
 	}
9805c9
       else if (is_input && t == FMT_ZERO)
9805c9
 	{
9805c9
@@ -4368,8 +4391,8 @@ get_io_list:
9805c9
     }
9805c9
 
9805c9
   /* See if we want to use defaults for missing exponents in real transfers
9805c9
-     and other DEC runtime extensions.  */
9805c9
-  if (flag_dec)
9805c9
+     and other DEC runtime extensions. */
9805c9
+  if (flag_dec_format_defaults)
9805c9
     dt->dec_ext = 1;
9805c9
 
9805c9
   /* A full IO statement has been matched.  Check the constraints.  spec_end is
9805c9
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
9805c9
index 9151d02c491..26e82601b62 100644
9805c9
--- a/gcc/fortran/lang.opt
9805c9
+++ b/gcc/fortran/lang.opt
9805c9
@@ -444,6 +444,10 @@ fdec-include
9805c9
 Fortran Var(flag_dec_include)
9805c9
 Enable legacy parsing of INCLUDE as statement.
9805c9
 
9805c9
+fdec-format-defaults
9805c9
+Fortran Var(flag_dec_format_defaults)
9805c9
+Enable default widths for i, f and g format specifiers.
9805c9
+
9805c9
 fdec-intrinsic-ints
9805c9
 Fortran Var(flag_dec_intrinsic_ints)
9805c9
 Enable kind-specific variants of integer intrinsic functions.
9805c9
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
9805c9
index 02970d59066..4f91486e977 100644
9805c9
--- a/gcc/fortran/options.c
9805c9
+++ b/gcc/fortran/options.c
9805c9
@@ -74,6 +74,7 @@ set_dec_flags (int value)
9805c9
   SET_BITFLAG (flag_dec_static, value, value);
9805c9
   SET_BITFLAG (flag_dec_math, value, value);
9805c9
   SET_BITFLAG (flag_dec_include, value, value);
9805c9
+  SET_BITFLAG (flag_dec_format_defaults, value, value);
9805c9
 }
9805c9
 
9805c9
 /* Finalize DEC flags.  */
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90 b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90
9805c9
new file mode 100644
9805c9
index 00000000000..49c77155761
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_1.f90
9805c9
@@ -0,0 +1,43 @@
9805c9
+! { dg-do run }
9805c9
+! { dg-options -fdec }
9805c9
+!
9805c9
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
9805c9
+!
9805c9
+! This feature is not part of any Fortran standard, but it is supported by the
9805c9
+! Oracle Fortran compiler and others.
9805c9
+!
9805c9
+! libgfortran uses printf() internally to implement FORMAT. If you print float
9805c9
+! values to a higher precision than the type can actually store, the results
9805c9
+! are implementation dependent: some platforms print zeros, others print random
9805c9
+! numbers. Don't depend on this behaviour in tests because they will not be
9805c9
+! portable.
9805c9
+
9805c9
+    character(50) :: buffer
9805c9
+
9805c9
+    real*4 :: real_4
9805c9
+    real*8 :: real_8
9805c9
+    real*16 :: real_16
9805c9
+    integer :: len
9805c9
+
9805c9
+    real_4 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":      4.1799998:") stop 1
9805c9
+
9805c9
+    real_4 = 0.00000018
9805c9
+    write(buffer, '(A, F, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":      0.0000002:") stop 2
9805c9
+
9805c9
+    real_8 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_8,':'
9805c9
+    print *,buffer
9805c9
+    len = len_trim(buffer)
9805c9
+    if (len /= 27) stop 3
9805c9
+
9805c9
+    real_16 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_16,':'
9805c9
+    print *,buffer
9805c9
+    len = len_trim(buffer)
9805c9
+    if (len /= 44) stop 4
9805c9
+end
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90 b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90
9805c9
new file mode 100644
9805c9
index 00000000000..1c2ec0413a7
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_2.f90
9805c9
@@ -0,0 +1,46 @@
9805c9
+! { dg-do run }
9805c9
+! { dg-options -fdec-format-defaults }
9805c9
+!
9805c9
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
9805c9
+!
9805c9
+! This feature is not part of any Fortran standard, but it is supported by the
9805c9
+! Oracle Fortran compiler and others.
9805c9
+!
9805c9
+! libgfortran uses printf() internally to implement FORMAT. If you print float
9805c9
+! values to a higher precision than the type can actually store, the results
9805c9
+! are implementation dependent: some platforms print zeros, others print random
9805c9
+! numbers. Don't depend on this behaviour in tests because they will not be
9805c9
+! portable.
9805c9
+!
9805c9
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
9805c9
+! use of -fdec-format-defaults
9805c9
+!
9805c9
+    character(50) :: buffer
9805c9
+
9805c9
+    real*4 :: real_4
9805c9
+    real*8 :: real_8
9805c9
+    real*16 :: real_16
9805c9
+    integer :: len
9805c9
+
9805c9
+    real_4 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":      4.1799998:") stop 1
9805c9
+
9805c9
+    real_4 = 0.00000018
9805c9
+    write(buffer, '(A, F, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":      0.0000002:") stop 2
9805c9
+
9805c9
+    real_8 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_8,':'
9805c9
+    print *,buffer
9805c9
+    len = len_trim(buffer)
9805c9
+    if (len /= 27) stop 3
9805c9
+
9805c9
+    real_16 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_16,':'
9805c9
+    print *,buffer
9805c9
+    len = len_trim(buffer)
9805c9
+    if (len /= 44) stop 4
9805c9
+end
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90 b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90
9805c9
new file mode 100644
9805c9
index 00000000000..e513063189b
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_f_default_field_width_3.f90
9805c9
@@ -0,0 +1,28 @@
9805c9
+! { dg-do compile }
9805c9
+! { dg-options "-fdec -fno-dec-format-defaults" }
9805c9
+!
9805c9
+! Test case for the default field widths not enabled.
9805c9
+!
9805c9
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
9805c9
+! use of -fno-dec-format-defaults
9805c9
+!
9805c9
+
9805c9
+    character(50) :: buffer
9805c9
+
9805c9
+    real*4 :: real_4
9805c9
+    real*8 :: real_8
9805c9
+    real*16 :: real_16
9805c9
+    integer :: len
9805c9
+
9805c9
+    real_4 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_4,':' ! { dg-error "Nonnegative width required" }
9805c9
+
9805c9
+    real_4 = 0.00000018
9805c9
+    write(buffer, '(A, F, A)') ':',real_4,':' ! { dg-error "Nonnegative width required" }
9805c9
+
9805c9
+    real_8 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_8,':' ! { dg-error "Nonnegative width required" }
9805c9
+
9805c9
+    real_16 = 4.18
9805c9
+    write(buffer, '(A, F, A)') ':',real_16,':' ! { dg-error "Nonnegative width required" }
9805c9
+end
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90 b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90
9805c9
new file mode 100644
9805c9
index 00000000000..6e2ad141d4a
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_1.f90
9805c9
@@ -0,0 +1,48 @@
9805c9
+! { dg-do run }
9805c9
+! { dg-options -fdec }
9805c9
+!
9805c9
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
9805c9
+!
9805c9
+! This feature is not part of any Fortran standard, but it is supported by the
9805c9
+! Oracle Fortran compiler and others.
9805c9
+!
9805c9
+! libgfortran uses printf() internally to implement FORMAT. If you print float
9805c9
+! values to a higher precision than the type can actually store, the results
9805c9
+! are implementation dependent: some platforms print zeros, others print random
9805c9
+! numbers. Don't depend on this behaviour in tests because they will not be
9805c9
+! portable.
9805c9
+
9805c9
+    character(50) :: buffer
9805c9
+
9805c9
+    real*4 :: real_4
9805c9
+    real*8 :: real_8
9805c9
+    real*16 :: real_16
9805c9
+    integer :: len
9805c9
+
9805c9
+    real_4 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":   4.180000    :") stop 1
9805c9
+
9805c9
+    real_4 = 0.00000018
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":  0.1800000E-06:") stop 2
9805c9
+
9805c9
+    real_4 = 18000000.4
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":  0.1800000E+08:") stop 3
9805c9
+
9805c9
+    real_8 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_8,':'
9805c9
+    print *,buffer
9805c9
+    len = len_trim(buffer)
9805c9
+    if (len /= 27) stop 4
9805c9
+
9805c9
+    real_16 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_16,':'
9805c9
+    print *,buffer
9805c9
+    len = len_trim(buffer)
9805c9
+    if (len /= 44) stop 5
9805c9
+end
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90 b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90
9805c9
new file mode 100644
9805c9
index 00000000000..7b218af8610
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_2.f90
9805c9
@@ -0,0 +1,52 @@
9805c9
+! { dg-do run }
9805c9
+! { dg-options -fdec-format-defaults }
9805c9
+!
9805c9
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
9805c9
+!
9805c9
+! This feature is not part of any Fortran standard, but it is supported by the
9805c9
+! Oracle Fortran compiler and others.
9805c9
+!
9805c9
+! libgfortran uses printf() internally to implement FORMAT. If you print float
9805c9
+! values to a higher precision than the type can actually store, the results
9805c9
+! are implementation dependent: some platforms print zeros, others print random
9805c9
+! numbers. Don't depend on this behaviour in tests because they will not be
9805c9
+! portable.
9805c9
+!
9805c9
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
9805c9
+! use of -fdec-format-defaults
9805c9
+!
9805c9
+
9805c9
+    character(50) :: buffer
9805c9
+
9805c9
+    real*4 :: real_4
9805c9
+    real*8 :: real_8
9805c9
+    real*16 :: real_16
9805c9
+    integer :: len
9805c9
+
9805c9
+    real_4 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":   4.180000    :") stop 1
9805c9
+
9805c9
+    real_4 = 0.00000018
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":  0.1800000E-06:") stop 2
9805c9
+
9805c9
+    real_4 = 18000000.4
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":  0.1800000E+08:") stop 3
9805c9
+
9805c9
+    real_8 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_8,':'
9805c9
+    print *,buffer
9805c9
+    len = len_trim(buffer)
9805c9
+    if (len /= 27) stop 4
9805c9
+
9805c9
+    real_16 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_16,':'
9805c9
+    print *,buffer
9805c9
+    len = len_trim(buffer)
9805c9
+    if (len /= 44) stop 5
9805c9
+end
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90 b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90
9805c9
new file mode 100644
9805c9
index 00000000000..e255c2f94a0
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_g_default_field_width_3.f90
9805c9
@@ -0,0 +1,31 @@
9805c9
+! { dg-do compile }
9805c9
+! { dg-options "-fdec -fno-dec-format-defaults" }
9805c9
+!
9805c9
+! Test case for the default field widths not enabled.
9805c9
+!
9805c9
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
9805c9
+! use of -fno-dec-format-defaults
9805c9
+!
9805c9
+
9805c9
+    character(50) :: buffer
9805c9
+
9805c9
+    real*4 :: real_4
9805c9
+    real*8 :: real_8
9805c9
+    real*16 :: real_16
9805c9
+    integer :: len
9805c9
+
9805c9
+    real_4 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':' ! { dg-error "Positive width required" }
9805c9
+
9805c9
+    real_4 = 0.00000018
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':' ! { dg-error "Positive width required" }
9805c9
+
9805c9
+    real_4 = 18000000.4
9805c9
+    write(buffer, '(A, G, A)') ':',real_4,':' ! { dg-error "Positive width required" }
9805c9
+
9805c9
+    real_8 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_8,':' ! { dg-error "Positive width required" }
9805c9
+
9805c9
+    real_16 = 4.18
9805c9
+    write(buffer, '(A, G, A)') ':',real_16,':' ! { dg-error "Positive width required" }
9805c9
+end
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90 b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90
9805c9
new file mode 100644
9805c9
index 00000000000..0d32d240394
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_1.f90
9805c9
@@ -0,0 +1,38 @@
9805c9
+! { dg-do run }
9805c9
+! { dg-options -fdec }
9805c9
+!
9805c9
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
9805c9
+!
9805c9
+! This feature is not part of any Fortran standard, but it is supported by the
9805c9
+! Oracle Fortran compiler and others.
9805c9
+
9805c9
+    character(50) :: buffer
9805c9
+    character(1) :: colon
9805c9
+
9805c9
+    integer*2 :: integer_2
9805c9
+    integer*4 :: integer_4
9805c9
+    integer*8 :: integer_8
9805c9
+
9805c9
+    write(buffer, '(A, I, A)') ':',12340,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":       12340:") stop 1
9805c9
+
9805c9
+    read(buffer, '(A1, I, A1)') colon, integer_4, colon
9805c9
+    if (integer_4.ne.12340) stop 2
9805c9
+
9805c9
+    integer_2 = -99
9805c9
+    write(buffer, '(A, I, A)') ':',integer_2,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":    -99:") stop 3
9805c9
+
9805c9
+    integer_8 = -11112222
9805c9
+    write(buffer, '(A, I, A)') ':',integer_8,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":              -11112222:") stop 4
9805c9
+
9805c9
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
9805c9
+    integer_2 = 789
9805c9
+    buffer = '0000000789'
9805c9
+    read(buffer, '(I)') integer_2
9805c9
+    if (integer_2.ne.0) stop 5
9805c9
+end
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90 b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90
9805c9
new file mode 100644
9805c9
index 00000000000..6cee3f86809
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_2.f90
9805c9
@@ -0,0 +1,42 @@
9805c9
+! { dg-do run }
9805c9
+! { dg-options -fdec-format-defaults }
9805c9
+!
9805c9
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
9805c9
+!
9805c9
+! This feature is not part of any Fortran standard, but it is supported by the
9805c9
+! Oracle Fortran compiler and others.
9805c9
+!
9805c9
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
9805c9
+! use of -fdec-format-defaults
9805c9
+!
9805c9
+
9805c9
+    character(50) :: buffer
9805c9
+    character(1) :: colon
9805c9
+
9805c9
+    integer*2 :: integer_2
9805c9
+    integer*4 :: integer_4
9805c9
+    integer*8 :: integer_8
9805c9
+
9805c9
+    write(buffer, '(A, I, A)') ':',12340,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":       12340:") stop 1
9805c9
+
9805c9
+    read(buffer, '(A1, I, A1)') colon, integer_4, colon
9805c9
+    if (integer_4.ne.12340) stop 2
9805c9
+
9805c9
+    integer_2 = -99
9805c9
+    write(buffer, '(A, I, A)') ':',integer_2,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":    -99:") stop 3
9805c9
+
9805c9
+    integer_8 = -11112222
9805c9
+    write(buffer, '(A, I, A)') ':',integer_8,':'
9805c9
+    print *,buffer
9805c9
+    if (buffer.ne.":              -11112222:") stop 4
9805c9
+
9805c9
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
9805c9
+    integer_2 = 789
9805c9
+    buffer = '0000000789'
9805c9
+    read(buffer, '(I)') integer_2
9805c9
+    if (integer_2.ne.0) stop 5
9805c9
+end
9805c9
diff --git a/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90 b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90
9805c9
new file mode 100644
9805c9
index 00000000000..3a6684b3c4d
9805c9
--- /dev/null
9805c9
+++ b/gcc/testsuite/gfortran.dg/fmt_i_default_field_width_3.f90
9805c9
@@ -0,0 +1,35 @@
9805c9
+! { dg-do compile }
9805c9
+! { dg-options "-fdec -fno-dec-format-defaults" }
9805c9
+!
9805c9
+! Test case for the default field widths enabled by the -fdec-format-defaults flag.
9805c9
+!
9805c9
+! This feature is not part of any Fortran standard, but it is supported by the
9805c9
+! Oracle Fortran compiler and others.
9805c9
+!
9805c9
+! Test case added by Mark Eggleston <mark.eggleston@codethink.com> to check
9805c9
+! use of -fdec-format-defaults
9805c9
+!
9805c9
+
9805c9
+    character(50) :: buffer
9805c9
+    character(1) :: colon
9805c9
+
9805c9
+    integer*2 :: integer_2
9805c9
+    integer*4 :: integer_4
9805c9
+    integer*8 :: integer_8
9805c9
+
9805c9
+    write(buffer, '(A, I, A)') ':',12340,':' ! { dg-error "Nonnegative width required" }
9805c9
+
9805c9
+    read(buffer, '(A1, I, A1)') colon, integer_4, colon ! { dg-error "Nonnegative width required" }
9805c9
+    if (integer_4.ne.12340) stop 2
9805c9
+
9805c9
+    integer_2 = -99
9805c9
+    write(buffer, '(A, I, A)') ':',integer_2,':' ! { dg-error "Nonnegative width required" }
9805c9
+
9805c9
+    integer_8 = -11112222
9805c9
+    write(buffer, '(A, I, A)') ':',integer_8,':' ! { dg-error "Nonnegative width required" }
9805c9
+
9805c9
+! If the width is 7 and there are 7 leading zeroes, the result should be zero.
9805c9
+    integer_2 = 789
9805c9
+    buffer = '0000000789'
9805c9
+    read(buffer, '(I)') integer_2 ! { dg-error "Nonnegative width required" }
9805c9
+end
9805c9
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
9805c9
index 688764785da..e798d9bda87 100644
9805c9
--- a/libgfortran/io/format.c
9805c9
+++ b/libgfortran/io/format.c
9805c9
@@ -956,12 +956,33 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
9805c9
 	  *seen_dd = true;
9805c9
 	  if (u != FMT_POSINT && u != FMT_ZERO)
9805c9
 	    {
9805c9
+	      if (dtp->common.flags & IOPARM_DT_DEC_EXT)
9805c9
+		{
9805c9
+		  tail->u.real.w = DEFAULT_WIDTH;
9805c9
+		  tail->u.real.d = 0;
9805c9
+		  tail->u.real.e = -1;
9805c9
+		  fmt->saved_token = u;
9805c9
+		  break;
9805c9
+		}
9805c9
 	      fmt->error = nonneg_required;
9805c9
 	      goto finished;
9805c9
 	    }
9805c9
 	}
9805c9
+      else if (u == FMT_ZERO)
9805c9
+	{
9805c9
+	  fmt->error = posint_required;
9805c9
+	  goto finished;
9805c9
+	}
9805c9
       else if (u != FMT_POSINT)
9805c9
 	{
9805c9
+	  if (dtp->common.flags & IOPARM_DT_DEC_EXT)
9805c9
+	    {
9805c9
+	      tail->u.real.w = DEFAULT_WIDTH;
9805c9
+	      tail->u.real.d = 0;
9805c9
+	      tail->u.real.e = -1;
9805c9
+	      fmt->saved_token = u;
9805c9
+	      break;
9805c9
+	    }
9805c9
 	  fmt->error = posint_required;
9805c9
 	  goto finished;
9805c9
 	}
9805c9
@@ -1100,6 +1121,13 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
9805c9
 	{
9805c9
 	  if (t != FMT_POSINT)
9805c9
 	    {
9805c9
+	      if (dtp->common.flags & IOPARM_DT_DEC_EXT)
9805c9
+		{
9805c9
+		  tail->u.integer.w = DEFAULT_WIDTH;
9805c9
+		  tail->u.integer.m = -1;
9805c9
+		  fmt->saved_token = t;
9805c9
+		  break;
9805c9
+		}
9805c9
 	      fmt->error = posint_required;
9805c9
 	      goto finished;
9805c9
 	    }
9805c9
@@ -1108,6 +1136,13 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
9805c9
 	{
9805c9
 	  if (t != FMT_ZERO && t != FMT_POSINT)
9805c9
 	    {
9805c9
+	      if (dtp->common.flags & IOPARM_DT_DEC_EXT)
9805c9
+		{
9805c9
+		  tail->u.integer.w = DEFAULT_WIDTH;
9805c9
+		  tail->u.integer.m = -1;
9805c9
+		  fmt->saved_token = t;
9805c9
+		  break;
9805c9
+		}
9805c9
 	      fmt->error = nonneg_required;
9805c9
 	      goto finished;
9805c9
 	    }
9805c9
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
9805c9
index 5caaea280f0..f5e63797ba1 100644
9805c9
--- a/libgfortran/io/io.h
9805c9
+++ b/libgfortran/io/io.h
9805c9
@@ -1011,6 +1011,56 @@ memset4 (gfc_char4_t *p, gfc_char4_t c, int k)
9805c9
     *p++ = c;
9805c9
 }
9805c9
 
9805c9
+/* Used in width fields to indicate that the default should be used */
9805c9
+#define DEFAULT_WIDTH -1
9805c9
+
9805c9
+/* Defaults for certain format field descriptors. These are decided based on
9805c9
+ * the type of the value being formatted.
9805c9
+ *
9805c9
+ * The behaviour here is modelled on the Oracle Fortran compiler. At the time
9805c9
+ * of writing, the details were available at this URL:
9805c9
+ *
9805c9
+ *   https://docs.oracle.com/cd/E19957-01/805-4939/6j4m0vnc3/index.html#z4000743746d
9805c9
+ */
9805c9
+
9805c9
+static inline int
9805c9
+default_width_for_integer (int kind)
9805c9
+{
9805c9
+  switch (kind)
9805c9
+    {
9805c9
+    case 1:
9805c9
+    case 2:  return  7;
9805c9
+    case 4:  return 12;
9805c9
+    case 8:  return 23;
9805c9
+    case 16: return 44;
9805c9
+    default: return  0;
9805c9
+    }
9805c9
+}
9805c9
+
9805c9
+static inline int
9805c9
+default_width_for_float (int kind)
9805c9
+{
9805c9
+  switch (kind)
9805c9
+    {
9805c9
+    case 4:  return 15;
9805c9
+    case 8:  return 25;
9805c9
+    case 16: return 42;
9805c9
+    default: return  0;
9805c9
+    }
9805c9
+}
9805c9
+
9805c9
+static inline int
9805c9
+default_precision_for_float (int kind)
9805c9
+{
9805c9
+  switch (kind)
9805c9
+    {
9805c9
+    case 4:  return 7;
9805c9
+    case 8:  return 16;
9805c9
+    case 16: return 33;
9805c9
+    default: return 0;
9805c9
+    }
9805c9
+}
9805c9
+
9805c9
 #endif
9805c9
 
9805c9
 extern void
9805c9
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
9805c9
index 52ffb4639ac..be9f6cb6f76 100644
9805c9
--- a/libgfortran/io/read.c
9805c9
+++ b/libgfortran/io/read.c
9805c9
@@ -635,6 +635,12 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
9805c9
 
9805c9
   w = f->u.w;
9805c9
 
9805c9
+  /* This is a legacy extension, and the frontend will only allow such cases
9805c9
+   * through when -fdec-format-defaults is passed.
9805c9
+   */
9805c9
+  if (w == DEFAULT_WIDTH)
9805c9
+    w = default_width_for_integer (length);
9805c9
+
9805c9
   p = read_block_form (dtp, &w);
9805c9
 
9805c9
   if (p == NULL)
9805c9
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
9805c9
index c8811e200e0..4ef35561fdd 100644
9805c9
--- a/libgfortran/io/write.c
9805c9
+++ b/libgfortran/io/write.c
9805c9
@@ -685,9 +685,8 @@ write_l (st_parameter_dt *dtp, const fnode *f, char *source, int len)
9805c9
   p[wlen - 1] = (n) ? 'T' : 'F';
9805c9
 }
9805c9
 
9805c9
-
9805c9
 static void
9805c9
-write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
9805c9
+write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n, int len)
9805c9
 {
9805c9
   int w, m, digits, nzero, nblank;
9805c9
   char *p;
9805c9
@@ -720,6 +719,9 @@ write_boz (st_parameter_dt *dtp, const fnode *f, const char *q, int n)
9805c9
   /* Select a width if none was specified.  The idea here is to always
9805c9
      print something.  */
9805c9
 
9805c9
+  if (w == DEFAULT_WIDTH)
9805c9
+    w = default_width_for_integer (len);
9805c9
+
9805c9
   if (w == 0)
9805c9
     w = ((digits < m) ? m : digits);
9805c9
 
9805c9
@@ -846,6 +848,8 @@ write_decimal (st_parameter_dt *dtp, const fnode *f, const char *source,
9805c9
 
9805c9
   /* Select a width if none was specified.  The idea here is to always
9805c9
      print something.  */
9805c9
+  if (w == DEFAULT_WIDTH)
9805c9
+    w = default_width_for_integer (len);
9805c9
 
9805c9
   if (w == 0)
9805c9
     w = ((digits < m) ? m : digits) + nsign;
9805c9
@@ -1206,13 +1210,13 @@ write_b (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
9805c9
   if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
9805c9
     {
9805c9
       p = btoa_big (source, itoa_buf, len, &n);
9805c9
-      write_boz (dtp, f, p, n);
9805c9
+      write_boz (dtp, f, p, n, len);
9805c9
     }
9805c9
   else
9805c9
     {
9805c9
       n = extract_uint (source, len);
9805c9
       p = btoa (n, itoa_buf, sizeof (itoa_buf));
9805c9
-      write_boz (dtp, f, p, n);
9805c9
+      write_boz (dtp, f, p, n, len);
9805c9
     }
9805c9
 }
9805c9
 
9805c9
@@ -1227,13 +1231,13 @@ write_o (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
9805c9
   if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
9805c9
     {
9805c9
       p = otoa_big (source, itoa_buf, len, &n);
9805c9
-      write_boz (dtp, f, p, n);
9805c9
+      write_boz (dtp, f, p, n, len);
9805c9
     }
9805c9
   else
9805c9
     {
9805c9
       n = extract_uint (source, len);
9805c9
       p = otoa (n, itoa_buf, sizeof (itoa_buf));
9805c9
-      write_boz (dtp, f, p, n);
9805c9
+      write_boz (dtp, f, p, n, len);
9805c9
     }
9805c9
 }
9805c9
 
9805c9
@@ -1247,13 +1251,13 @@ write_z (st_parameter_dt *dtp, const fnode *f, const char *source, int len)
9805c9
   if (len > (int) sizeof (GFC_UINTEGER_LARGEST))
9805c9
     {
9805c9
       p = ztoa_big (source, itoa_buf, len, &n);
9805c9
-      write_boz (dtp, f, p, n);
9805c9
+      write_boz (dtp, f, p, n, len);
9805c9
     }
9805c9
   else
9805c9
     {
9805c9
       n = extract_uint (source, len);
9805c9
       p = gfc_xtoa (n, itoa_buf, sizeof (itoa_buf));
9805c9
-      write_boz (dtp, f, p, n);
9805c9
+      write_boz (dtp, f, p, n, len);
9805c9
     }
9805c9
 }
9805c9
 
9805c9
@@ -1491,7 +1495,7 @@ size_from_kind (st_parameter_dt *dtp, const fnode *f, int kind)
9805c9
 {
9805c9
   int size;
9805c9
 
9805c9
-  if (f->format == FMT_F && f->u.real.w == 0)
9805c9
+  if ((f->format == FMT_F && f->u.real.w == 0) || f->u.real.w == DEFAULT_WIDTH)
9805c9
     {
9805c9
       switch (kind)
9805c9
       {
9805c9
diff --git a/libgfortran/io/write_float.def b/libgfortran/io/write_float.def
9805c9
index c63db4e77ef..daa16679f53 100644
9805c9
--- a/libgfortran/io/write_float.def
9805c9
+++ b/libgfortran/io/write_float.def
9805c9
@@ -113,7 +113,8 @@ determine_precision (st_parameter_dt * dtp, const fnode * f, int len)
9805c9
 static void
9805c9
 build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
9805c9
 		    size_t size, int nprinted, int precision, int sign_bit,
9805c9
-		    bool zero_flag, int npad, char *result, size_t *len)
9805c9
+		    bool zero_flag, int npad, int default_width, char *result,
9805c9
+		    size_t *len)
9805c9
 {
9805c9
   char *put;
9805c9
   char *digits;
9805c9
@@ -132,8 +133,17 @@ build_float_string (st_parameter_dt *dtp, const fnode *f, char *buffer,
9805c9
   sign_t sign;
9805c9
 
9805c9
   ft = f->format;
9805c9
-  w = f->u.real.w;
9805c9
-  d = f->u.real.d;
9805c9
+  if (f->u.real.w == DEFAULT_WIDTH)
9805c9
+    /* This codepath can only be reached with -fdec-format-defaults. */
9805c9
+    {
9805c9
+      w = default_width;
9805c9
+      d = precision;
9805c9
+    }
9805c9
+  else
9805c9
+    {
9805c9
+      w = f->u.real.w;
9805c9
+      d = f->u.real.d;
9805c9
+    }
9805c9
   p = dtp->u.p.scale_factor;
9805c9
   *len = 0;
9805c9
 
9805c9
@@ -960,6 +970,11 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
9805c9
       int save_scale_factor;\
9805c9
       volatile GFC_REAL_ ## x temp;\
9805c9
       save_scale_factor = dtp->u.p.scale_factor;\
9805c9
+      if (w == DEFAULT_WIDTH)\
9805c9
+	{\
9805c9
+	  w = default_width;\
9805c9
+	  d = precision;\
9805c9
+	}\
9805c9
       switch (dtp->u.p.current_unit->round_status)\
9805c9
 	{\
9805c9
 	  case ROUND_ZERO:\
9805c9
@@ -1035,7 +1050,8 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
9805c9
 	  nprinted = FDTOA(y,precision,m);\
9805c9
 	}\
9805c9
       build_float_string (dtp, &newf, buffer, size, nprinted, precision,\
9805c9
-				   sign_bit, zero_flag, npad, result, res_len);\
9805c9
+				   sign_bit, zero_flag, npad, default_width,\
9805c9
+				   result, res_len);\
9805c9
       dtp->u.p.scale_factor = save_scale_factor;\
9805c9
     }\
9805c9
   else\
9805c9
@@ -1045,7 +1061,8 @@ determine_en_precision (st_parameter_dt *dtp, const fnode *f,
9805c9
       else\
9805c9
 	nprinted = DTOA(y,precision,m);\
9805c9
       build_float_string (dtp, f, buffer, size, nprinted, precision,\
9805c9
-				   sign_bit, zero_flag, npad, result, res_len);\
9805c9
+				   sign_bit, zero_flag, npad, default_width,\
9805c9
+				   result, res_len);\
9805c9
     }\
9805c9
 }\
9805c9
 
9805c9
@@ -1059,6 +1076,16 @@ get_float_string (st_parameter_dt *dtp, const fnode *f, const char *source,
9805c9
 {
9805c9
   int sign_bit, nprinted;
9805c9
   bool zero_flag;
9805c9
+  int default_width = 0;
9805c9
+
9805c9
+  if (f->u.real.w == DEFAULT_WIDTH)
9805c9
+    /* This codepath can only be reached with -fdec-format-defaults. The default
9805c9
+     * values are based on those used in the Oracle Fortran compiler.
9805c9
+     */
9805c9
+    {
9805c9
+      default_width = default_width_for_float (kind);
9805c9
+      precision = default_precision_for_float (kind);
9805c9
+    }
9805c9
 
9805c9
   switch (kind)
9805c9
     {
9805c9
-- 
9805c9
2.11.0
9805c9