aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog7
-rw-r--r--gcc/fortran/io.c33
-rw-r--r--gcc/testsuite/ChangeLog8
-rw-r--r--gcc/testsuite/gfortran.dg/fmt_error_10.f4
-rw-r--r--gcc/testsuite/gfortran.dg/fmt_error_7.f4
-rw-r--r--gcc/testsuite/gfortran.dg/fmt_error_9.f2
-rw-r--r--gcc/testsuite/gfortran.dg/fmt_zero_width.f9036
-rw-r--r--libgfortran/ChangeLog17
-rw-r--r--libgfortran/io/format.c8
-rw-r--r--libgfortran/io/format.h16
-rw-r--r--libgfortran/io/io.h18
-rw-r--r--libgfortran/io/transfer.c22
-rw-r--r--libgfortran/io/write.c25
13 files changed, 152 insertions, 48 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f9f9da2..5023949 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2019-11-06 Jerry DeLisle <jvdelisle@gcc.ngu.org>
+
+ PR fortran/90374
+ * io.c (check_format): Allow zero width for D, E, EN, and ES
+ specifiers as default and when -std=F2018 is given. Retain
+ existing errors when using the -fdec family of flags.
+
2019-11-03 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/92113
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index b969a1a..57a3fdd 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -922,19 +922,38 @@ data_desc:
if (u != FMT_POSINT)
{
+ if (flag_dec)
+ {
+ if (flag_dec_format_defaults)
+ {
+ /* Assume a default width based on the variable size. */
+ saved_token = u;
+ break;
+ }
+ else
+ {
+ gfc_error ("Positive width required in format "
+ "specifier %s at %L", token_to_string (t),
+ &format_locus);
+ saved_token = u;
+ goto fail;
+ }
+ }
+
+ format_locus.nextc += format_string_pos;
+ if (!gfc_notify_std (GFC_STD_F2018,
+ "positive width required at %L",
+ &format_locus))
+ {
+ saved_token = u;
+ goto fail;
+ }
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),
- &format_locus);
- saved_token = u;
- goto fail;
}
u = format_lex ();
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e404453..6bb85a3 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-06 Jerry DeLisle <jvdelisle@gcc.ngu.org>
+
+ PR fortran/90374
+ * gfortran.dg/fmt_error_10.f: Modify for new constraints.
+ * gfortran.dg/fmt_error_7.f: Add dg-options "-std=f95".
+ * gfortran.dg/fmt_error_9.f: Modify for new constraints.
+ * gfortran.dg/fmt_zero_width.f90: New test.
+
2019-11-07 Joseph Myers <joseph@codesourcery.com>
* gcc.dg/asm-wide-1.c, gcc.dg/diagnostic-token-ranges.c,
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_10.f b/gcc/testsuite/gfortran.dg/fmt_error_10.f
index 7ea6aec..6e1a5f6 100644
--- a/gcc/testsuite/gfortran.dg/fmt_error_10.f
+++ b/gcc/testsuite/gfortran.dg/fmt_error_10.f
@@ -18,9 +18,9 @@
str = '(1pd0.15)'
write (line,str,iostat=istat, iomsg=msg) 1.0d0
- if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 5
+ if (line.ne."1.000000000000000") STOP 5
read (*,str,iostat=istat, iomsg=msg) x
- if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 6
+ if (istat.ne.5006 .or. msg(1:10).ne."Zero width") STOP 6
if (x.ne.555.25) STOP 7
write (line,'(1pd24.15e11.3)') 1.0d0, 1.234
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_7.f b/gcc/testsuite/gfortran.dg/fmt_error_7.f
index 9b5fba9..3937c8f 100644
--- a/gcc/testsuite/gfortran.dg/fmt_error_7.f
+++ b/gcc/testsuite/gfortran.dg/fmt_error_7.f
@@ -1,7 +1,9 @@
! { dg-do compile }
+! { dg-options "-std=f95" }
+
! PR37446 Diagnostic of edit descriptors, esp. EN
character(40) :: fmt_string
write(*, '(1P,2E12.4)') 1.0
- write(*,'(EN)') 5.0 ! { dg-error "Positive width required" }
+ write(*,'(EN)') 5.0 ! { dg-error "positive width required" }
write(*,'("abcdefg",EN6,"hjjklmnop")') 5.0 ! { dg-error "Period required" }
end
diff --git a/gcc/testsuite/gfortran.dg/fmt_error_9.f b/gcc/testsuite/gfortran.dg/fmt_error_9.f
index 1d67750..40c73599 100644
--- a/gcc/testsuite/gfortran.dg/fmt_error_9.f
+++ b/gcc/testsuite/gfortran.dg/fmt_error_9.f
@@ -16,7 +16,7 @@
write (line,str,iostat=istat, iomsg=msg) 1.0d0
if (istat.ne.0) STOP 3
read (*,str,iostat=istat, iomsg=msg) x
- if (istat.ne.5006 .or. msg(1:15).ne."Positive width ") STOP 4
+ if (istat.ne.5006 .or. msg(1:10).ne."Zero width") STOP 4
if (x.ne.555.25) STOP 5
write (line,'(1pd24.15e11.3)') 1.0d0, 1.234
diff --git a/gcc/testsuite/gfortran.dg/fmt_zero_width.f90 b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
new file mode 100644
index 0000000..093c0a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_zero_width.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! PR90374 "5.5 d0.d, e0.d, es0.d, en0.d, g0.d and ew.d edit descriptors
+program pr90374
+ real(4) :: rn
+ character(32) :: afmt, aresult
+ real(8) :: one = 1.0D0, zero = 0.0D0, nan, pinf, minf
+
+ nan = zero/zero
+ rn = 0.00314_4
+ afmt = "(D0.3)"
+ write (aresult,fmt=afmt) rn
+ if (aresult /= "0.314D-02") stop 12
+ afmt = "(E0.10)"
+ write (aresult,fmt=afmt) rn
+ if (aresult /= "0.3139999928E-02") stop 15
+ afmt = "(ES0.10)"
+ write (aresult,fmt=afmt) rn
+ if (aresult /= "3.1399999280E-03") stop 18
+ afmt = "(EN0.10)"
+ write (aresult,fmt=afmt) rn
+ if (aresult /= "3.1399999280E-03") stop 21
+ afmt = "(G0.10)"
+ write (aresult,fmt=afmt) rn
+ if (aresult /= "0.3139999928E-02") stop 24
+ write (aresult,fmt="(D0.3)") rn
+ if (aresult /= "0.314D-02") stop 26
+ write (aresult,fmt="(E0.10)") rn
+ if (aresult /= "0.3139999928E-02") stop 28
+ write (aresult,fmt="(ES0.10)") rn
+ if (aresult /= "3.1399999280E-03") stop 30
+ write (aresult,fmt="(EN0.10)") rn
+ if (aresult /= "3.1399999280E-03") stop 32
+ write (aresult,fmt="(G0.10)") rn
+ if (aresult /= "0.3139999928E-02") stop 34
+
+end
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index c2031cf..0684c35 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,20 @@
+2019-11-06 Jerry DeLisle <jvdelisle@gcc.ngu.org>
+
+ PR fortran/90374
+ io/format.c (parse_format_list): Relax format checking for
+ zero width as default and when -std=f2018.
+ io/format.h (format_token): Move definition to io.h.
+ io/io.h (format_token): Add definition here to allow access to
+ this definition at higher levels. Rename the declaration of
+ write_real_g0 to write_real_w0 and add a new format_token
+ argument, allowing higher level functions to pass in the
+ token for handling of g0 vs the other zero width specifiers.
+ io/transfer.c (formatted_transfer_scalar_write): Add checks for
+ zero width and call write_real_w0 to handle it.
+ io/write.c (write_real_g0): Remove.
+ (write_real_w0): Add new, same as previous write_real_g0 except
+ check format token to handle the g0 case.
+
2019-10-31 Tobias Burnus <tobias@codesourcery.com>
PR fortran/92284.
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index e798d9b..b336208 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -925,7 +925,7 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
tail->repeat = repeat;
u = format_lex (fmt);
- if (t == FMT_G && u == FMT_ZERO)
+ if (u == FMT_ZERO)
{
*seen_dd = true;
if (notification_std (GFC_STD_F2008) == NOTIFICATION_ERROR
@@ -944,10 +944,8 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
u = format_lex (fmt);
if (u != FMT_POSINT)
- {
- fmt->error = posint_required;
- goto finished;
- }
+ notify_std (&dtp->common, GFC_STD_F2003,
+ "Positive width required");
tail->u.real.d = fmt->value;
break;
}
diff --git a/libgfortran/io/format.h b/libgfortran/io/format.h
index 84169e9..a089973 100644
--- a/libgfortran/io/format.h
+++ b/libgfortran/io/format.h
@@ -27,22 +27,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "io.h"
-
-/* Format tokens. Only about half of these can be stored in the
- format nodes. */
-
-typedef enum
-{
- FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
- FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
- FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
- FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
- FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC,
- FMT_DP, FMT_STAR, FMT_RC, FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ, FMT_DT
-}
-format_token;
-
-
/* Format nodes. A format string is converted into a tree of these
structures, which is traversed as part of a data transfer statement. */
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index bcd6dde..5b89d47 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -132,6 +132,20 @@ typedef struct format_hash_entry
}
format_hash_entry;
+/* Format tokens. Only about half of these can be stored in the
+ format nodes. */
+
+typedef enum
+{
+ FMT_NONE = 0, FMT_UNKNOWN, FMT_SIGNED_INT, FMT_ZERO, FMT_POSINT, FMT_PERIOD,
+ FMT_COMMA, FMT_COLON, FMT_SLASH, FMT_DOLLAR, FMT_T, FMT_TR, FMT_TL,
+ FMT_LPAREN, FMT_RPAREN, FMT_X, FMT_S, FMT_SS, FMT_SP, FMT_STRING,
+ FMT_BADSTRING, FMT_P, FMT_I, FMT_B, FMT_BN, FMT_BZ, FMT_O, FMT_Z, FMT_F,
+ FMT_E, FMT_EN, FMT_ES, FMT_G, FMT_L, FMT_A, FMT_D, FMT_H, FMT_END, FMT_DC,
+ FMT_DP, FMT_STAR, FMT_RC, FMT_RD, FMT_RN, FMT_RP, FMT_RU, FMT_RZ, FMT_DT
+}
+format_token;
+
/* Representation of a namelist object in libgfortran
Namelist Records
@@ -928,8 +942,8 @@ internal_proto(write_o);
extern void write_real (st_parameter_dt *, const char *, int);
internal_proto(write_real);
-extern void write_real_g0 (st_parameter_dt *, const char *, int, int);
-internal_proto(write_real_g0);
+extern void write_real_w0 (st_parameter_dt *, const char *, int, format_token, int);
+internal_proto(write_real_w0);
extern void write_x (st_parameter_dt *, int, int);
internal_proto(write_x);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 4c5e210..6382d0d 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2008,7 +2008,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
goto need_data;
if (require_type (dtp, BT_REAL, type, f))
return;
- write_d (dtp, f, p, kind);
+ if (f->u.real.w == 0)
+ write_real_w0 (dtp, p, kind, FMT_D, f->u.real.d);
+ else
+ write_d (dtp, f, p, kind);
break;
case FMT_DT:
@@ -2071,7 +2074,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
goto need_data;
if (require_type (dtp, BT_REAL, type, f))
return;
- write_e (dtp, f, p, kind);
+ if (f->u.real.w == 0)
+ write_real_w0 (dtp, p, kind, FMT_E, f->u.real.d);
+ else
+ write_e (dtp, f, p, kind);
break;
case FMT_EN:
@@ -2079,7 +2085,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
goto need_data;
if (require_type (dtp, BT_REAL, type, f))
return;
- write_en (dtp, f, p, kind);
+ if (f->u.real.w == 0)
+ write_real_w0 (dtp, p, kind, FMT_EN, f->u.real.d);
+ else
+ write_en (dtp, f, p, kind);
break;
case FMT_ES:
@@ -2087,7 +2096,10 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
goto need_data;
if (require_type (dtp, BT_REAL, type, f))
return;
- write_es (dtp, f, p, kind);
+ if (f->u.real.w == 0)
+ write_real_w0 (dtp, p, kind, FMT_ES, f->u.real.d);
+ else
+ write_es (dtp, f, p, kind);
break;
case FMT_F:
@@ -2117,7 +2129,7 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
break;
case BT_REAL:
if (f->u.real.w == 0)
- write_real_g0 (dtp, p, kind, f->u.real.d);
+ write_real_w0 (dtp, p, kind, FMT_G, f->u.real.d);
else
write_d (dtp, f, p, kind);
break;
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index eacd1f7..5ebe83b 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1720,25 +1720,32 @@ write_real (st_parameter_dt *dtp, const char *source, int kind)
compensate for the extra digit. */
void
-write_real_g0 (st_parameter_dt *dtp, const char *source, int kind, int d)
+write_real_w0 (st_parameter_dt *dtp, const char *source, int kind,
+ format_token fmt, int d)
{
fnode f;
char buf_stack[BUF_STACK_SZ];
char str_buf[BUF_STACK_SZ];
char *buffer, *result;
size_t buf_size, res_len, flt_str_len;
- int comp_d;
+ int comp_d = 0;
set_fnode_default (dtp, &f, kind);
if (d > 0)
f.u.real.d = d;
+ f.format = fmt;
+
+ /* For FMT_G, Compensate for extra digits when using scale factor, d
+ is not specified, and the magnitude is such that E editing
+ is used. */
+ if (fmt == FMT_G)
+ {
+ if (dtp->u.p.scale_factor > 0 && d == 0)
+ comp_d = 1;
+ else
+ comp_d = 0;
+ }
- /* Compensate for extra digits when using scale factor, d is not
- specified, and the magnitude is such that E editing is used. */
- if (dtp->u.p.scale_factor > 0 && d == 0)
- comp_d = 1;
- else
- comp_d = 0;
dtp->u.p.g0_no_blanks = 1;
/* Precision for snprintf call. */
@@ -1750,7 +1757,7 @@ write_real_g0 (st_parameter_dt *dtp, const char *source, int kind, int d)
buffer = select_buffer (dtp, &f, precision, buf_stack, &buf_size, kind);
get_float_string (dtp, &f, source , kind, comp_d, buffer,
- precision, buf_size, result, &flt_str_len);
+ precision, buf_size, result, &flt_str_len);
write_float_string (dtp, result, flt_str_len);
dtp->u.p.g0_no_blanks = 0;
generated by cgit v1.1 at 2024-07-30 02:17:08 +0000