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

4 files changed, 116 insertions, 4 deletions

diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index aa23330..4c82c4a 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -1,6 +1,6 @@
 /* Handle errors.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
-   Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
+   Foundation, Inc.
    Contributed by Andy Vaught & Niels Kristian Bech Jensen
 
 This file is part of GCC.
@@ -483,6 +483,22 @@ gfc_warning (const char *nocmsgid, ...)
 }
 
 
+/* Whether, for a feature included in a given standard set (GFC_STD_*),
+   we should issue an error or a warning, or be quiet.  */
+
+notification
+gfc_notification_std (int std)
+{
+  bool warning;
+
+  warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
+  if ((gfc_option.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
    standard does not contain the requested bits.  Return FAILURE if
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index aa66980..17e9777 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -129,6 +129,14 @@ typedef enum
 { SUCCESS = 1, FAILURE }
 try;
 
+/* This is returned by gfc_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;
+
 /* Matchers return one of these three values.  The difference between
    MATCH_NO and MATCH_ERROR is that MATCH_ERROR means that a match was
    successful, but that something non-syntactic is wrong and an error
@@ -1737,6 +1745,7 @@ void gfc_internal_error (const char *, ...) ATTRIBUTE_NORETURN ATTRIBUTE_GCC_GFC
 void gfc_clear_error (void);
 int gfc_error_check (void);
 
+notification gfc_notification_std (int);
 try gfc_notify_std (int, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 
 /* A general purpose syntax error.  */
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 618d056..b45e983a 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -569,8 +569,26 @@ data_desc:
       if (t == FMT_POSINT)
 	break;
 
-      error = posint_required;
-      goto syntax;
+      switch (gfc_notification_std (GFC_STD_GNU))
+	{
+	  case WARNING:
+	    gfc_warning
+	      ("Extension: Missing positive width after L descriptor at %C");
+	    saved_token = t;
+	    break;
+
+	  case ERROR:
+	    error = posint_required;
+	    goto syntax;
+
+	  case SILENT:
+	    saved_token = t;
+	    break;
+
+	  default:
+	    gcc_unreachable ();
+	}
+      break;
 
     case FMT_A:
       t = format_lex ();
diff --git a/gcc/testsuite/gfortran.dg/fmt_l.f90 b/gcc/testsuite/gfortran.dg/fmt_l.f90
new file mode 100644
index 0000000..e03f63d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_l.f90
@@ -0,0 +1,69 @@
+! { dg-do run }
+! { dg-options "-std=gnu -pedantic -ffree-line-length-none" }
+! Test the GNU extension of a L format descriptor without width
+! PR libfortran/21303
+program test_l
+  logical(kind=1) :: l1
+  logical(kind=2) :: l2
+  logical(kind=4) :: l4
+  logical(kind=8) :: l8
+
+  character(len=20) :: str
+
+  l1 = .true.
+  write (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l1 .neqv. .true.) call abort
+
+  l2 = .true.
+  write (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l2 .neqv. .true.) call abort
+
+  l4 = .true.
+  write (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l4 .neqv. .true.) call abort
+
+  l8 = .true.
+  write (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l8 .neqv. .true.) call abort
+
+  l1 = .false.
+  write (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l1 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l1 .neqv. .false.) call abort
+
+  l2 = .false.
+  write (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l2 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l2 .neqv. .false.) call abort
+
+  l4 = .false.
+  write (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l4 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l4 .neqv. .false.) call abort
+
+  l8 = .false.
+  write (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  read (str,"(L)") l8 ! { dg-warning "Extension: Missing positive width after L descriptor" }
+  if (l8 .neqv. .false.) call abort
+
+end program test_l
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }
+! { dg-output "Fortran runtime warning: Positive width required in format\n" }