aboutsummaryrefslogtreecommitdiff
path: root/libgfortran
diff options
context:
space:
mode:
authorFrançois-Xavier Coudert <fxcoudert@gcc.gnu.org>2006-02-19 21:31:02 +0000
committerFrançois-Xavier Coudert <fxcoudert@gcc.gnu.org>2006-02-19 21:31:02 +0000
commit8f0d39a86b963ad0d39edb2e7bf633b5790432fc (patch)
tree0f202b9e85194d9bc5ec4b762d158c3dabb04d2c /libgfortran
parentf5dc42bbcc9180a661f1447efda575d6362cf9fc (diff)
downloadgcc-8f0d39a86b963ad0d39edb2e7bf633b5790432fc.zip
gcc-8f0d39a86b963ad0d39edb2e7bf633b5790432fc.tar.gz
gcc-8f0d39a86b963ad0d39edb2e7bf633b5790432fc.tar.bz2
re PR libfortran/21303 (L edit descriptor without a width)
PR libfortran/21303 * gfortran.h (notification): New enumeration. (gfc_notification_std): Prototype for the new function. * error.c (gfc_notification_std): New function. * io.c (check_format): Handle the case of a L format descriptor without a width. * runtime/error.c (notification_std): New function. * libgfortran.h (notification): New enumeration. * io/io.h (notification_std): Prototype for the new function. * io/format.c (parse_format_list): Handle the case of a L format descriptor without a width. * gcc/testsuite/gfortran.dg/fmt_l.f90: New test. From-SVN: r111281
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/io/format.c15
-rw-r--r--libgfortran/io/io.h5
-rw-r--r--libgfortran/libgfortran.h7
-rw-r--r--libgfortran/runtime/error.c19
4 files changed, 42 insertions, 4 deletions
diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 23ea317..9528dba 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2004, 2005
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006
Free Software Foundation, Inc.
Contributed by Andy Vaught
@@ -662,8 +662,17 @@ parse_format_list (st_parameter_dt *dtp)
t = format_lex (fmt);
if (t != FMT_POSINT)
{
- fmt->error = posint_required;
- goto finished;
+ if (notification_std(GFC_STD_GNU) == ERROR)
+ {
+ fmt->error = posint_required;
+ goto finished;
+ }
+ else
+ {
+ fmt->saved_token = t;
+ fmt->value = 1; /* Default width */
+ notify_std(GFC_STD_GNU, posint_required);
+ }
}
get_fnode (fmt, &head, &tail, FMT_L);
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 0d2d795..9b35ef9 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
+/* Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of the GNU Fortran 95 runtime library (libgfortran).
@@ -843,6 +843,9 @@ internal_proto(list_formatted_write);
extern try notify_std (int, const char *);
internal_proto(notify_std);
+extern notification notification_std(int);
+internal_proto(notification_std);
+
/* size_from_kind.c */
extern size_t size_from_real_kind (int);
internal_proto(size_from_real_kind);
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index f1a1a3e..524c57e 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -404,6 +404,13 @@ error_codes;
#define GFC_FPE_UNDERFLOW (1<<4)
#define GFC_FPE_PRECISION (1<<5)
+/* This is returned by notification_std to know if, given the flags
+ that were given (-std=, -pedantic) we should issue an error, a warning
+ or nothing. */
+typedef enum
+{ SILENT, WARNING, ERROR }
+notification;
+
/* The filename and line number don't go inside the globals structure.
They are set by the rest of the program and must be linked to. */
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index b25cd0c..e102449 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -498,6 +498,25 @@ generate_error (st_parameter_common *cmp, int family, const char *message)
}
+/* Whether, for a feature included in a given standard set (GFC_STD_*),
+ we should issue an error or a warning, or be quiet. */
+
+notification
+notification_std (int std)
+{
+ int warning;
+
+ if (!compile_options.pedantic)
+ return SILENT;
+
+ warning = compile_options.warn_std & std;
+ if ((compile_options.allow_std & std) != 0 && !warning)
+ return SILENT;
+
+ return warning ? WARNING : ERROR;
+}
+
+
/* Possibly issue a warning/error about use of a nonstandard (or deleted)
feature. An error/warning will be issued if the currently selected