re PR fortran/54679 (Erroneous "Expected P edit descriptor" in conjunction with L...

2016-10-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/54679
	* io.c (check_format): Adjust checks for FMT_L to treat a zero
	width as an extension, giving warnings or error as appropriate.
	Improve messages.
	PR libgfortran/54679
	* io/format.c (parse_format_list): Adjust checks for FMT_L to
	treat a zero width as an extension, giving warnings or error
	as appropriate. Improve messages.
	PR fortran/54679
	* gfortran.dg/fmt_l.f90: Update test.
	* gfortran.dg/fmt_l0.f90: New test.

From-SVN: r241720

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f593ab7bb91e62cf025e8bf187ef8f01814f3845..d3120e59fdf3d7c78ddec463931582b95f06a51b 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2016-10-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/54679
+       * io.c (check_format): Adjust checks for FMT_L to treat a zero
+       width as an extension, giving warnings or error as appropriate.
+       Improve messages.
+
 2016-10-31  Jakub Jelinek  <jakub@redhat.com>
 
        * trans-types.c (gfc_get_array_descr_info): For -gdwarf-5 or

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index dce0f7cd97008e8ee7a4aeff4478bdf64c2f28b6..80cf8308da71fa705443e2efd7851a173d400072 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -601,7 +601,7 @@ check_format (bool is_input)
   const char *unexpected_end     = _("Unexpected end of format string");
   const char *zero_width         = _("Zero width in format descriptor");
 
-  const char *error;
+  const char *error = NULL;
   format_token t, u;
   int level;
   int repeat;
@@ -867,27 +867,31 @@ data_desc:
        goto fail;
       if (t == FMT_POSINT)
        break;
-
-      switch (gfc_notification_std (GFC_STD_GNU))
+      if (mode != MODE_FORMAT)
+       format_locus.nextc += format_string_pos;
+      if (t == FMT_ZERO)
        {
-         case WARNING:
-           if (mode != MODE_FORMAT)
-             format_locus.nextc += format_string_pos;
-           gfc_warning (0, "Extension: Missing positive width after L "
-                        "descriptor at %L", &format_locus);
-           saved_token = t;
-           break;
-
-         case ERROR:
-           error = posint_required;
-           goto syntax;
-
-         case SILENT:
-           saved_token = t;
-           break;
-
-         default:
-           gcc_unreachable ();
+         switch (gfc_notification_std (GFC_STD_GNU))
+           {
+             case WARNING:
+               gfc_warning (0, "Extension: Zero width after L "
+                            "descriptor at %L", &format_locus);
+               break;
+             case ERROR:
+               gfc_error ("Extension: Zero width after L "
+                            "descriptor at %L", &format_locus);
+               goto fail;
+             case SILENT:
+               break;
+             default:
+               gcc_unreachable ();
+           }
+       }
+      else
+       {
+         saved_token = t;
+         gfc_notify_std (GFC_STD_GNU, "Missing positive width after "
+                         "L descriptor at %L", &format_locus);
        }
       break;
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 25bf8932eee0f6383f47536d4970ec4a8e60d988..36b4d8ecb3209fb037aefc36840a4227bd7a37b8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2016-10-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/54679
+       * gfortran.dg/fmt_l.f90: Update test.
+       * gfortran.dg/fmt_l0.f90: New test.
+
 2016-10-31  Jakub Jelinek  <jakub@redhat.com>
 
        PR c++/78089

diff --git a/gcc/testsuite/gfortran.dg/fmt_l.f90 b/gcc/testsuite/gfortran.dg/fmt_l.f90
index 9dc4f57047322c1766930088383b6fcabf5f739a..0fd195515fcd2d53595de358e128102eca4a234b 100644 (file)
--- a/gcc/testsuite/gfortran.dg/fmt_l.f90
+++ b/gcc/testsuite/gfortran.dg/fmt_l.f90
@@ -52,34 +52,34 @@ program test_l
 
 end program test_l
 ! { dg-output "At line 14 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 15 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 19 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 20 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 24 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 25 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 29 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 30 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 34 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 35 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 39 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 40 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 44 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 45 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 49 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }
 ! { dg-output "At line 50 of file.*" }
-! { dg-output "Fortran runtime warning: Positive width required in format(\n|\r\n|\r)" }
+! { dg-output "Fortran runtime warning: Positive width required with L descriptor(\n|\r\n|\r)" }

diff --git a/gcc/testsuite/gfortran.dg/fmt_l0.f90 b/gcc/testsuite/gfortran.dg/fmt_l0.f90
new file mode 100644 (file)
index 0000000..fab1ffb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/fmt_l0.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-std=gnu -pedantic" }
+! Test the GNU extension of a L format descriptor without width
+! PR libfortran/54679
+program main
+  implicit none
+  character(len=20) :: str
+  character(len=60) :: format2 = "(2(1x,l0,1x))"
+  write(str,format2)
+end program main
+! { dg-output "At line 9 of file.*" }
+! { dg-output "Fortran runtime warning: Zero width after L descriptor(\n|\r\n|\r)" }

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 78d3949240b600a866a4591cf65a106b822515c7..745adf798d2e2382b44b67ee0fa39c4ec9f8ef73 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2016-10-31  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libgfortran/54679
+       * io/format.c (parse_format_list): Adjust checks for FMT_L to
+       treat a zero width as an extension, giving warnings or error
+       as appropriate. Improve messages.
+
 2016-10-30  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/78123

diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 31bc642910a9dbdfa44d4d5ecb64f33faea38f8a..8a1859749e160af041d2f84fc0d23ce4efd84994 100644 (file)
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -870,19 +870,25 @@ parse_format_list (st_parameter_dt *dtp, bool *seen_dd)
       t = format_lex (fmt);
       if (t != FMT_POSINT)
        {
-         if (notification_std(GFC_STD_GNU) == NOTIFICATION_ERROR)
+         if (t == FMT_ZERO)
            {
-             fmt->error = posint_required;
-             goto finished;
+             if (notification_std(GFC_STD_GNU) == NOTIFICATION_ERROR)
+               {
+                 fmt->error = "Extension: Zero width after L descriptor";
+                 goto finished;
+               }
+             else
+               notify_std (&dtp->common, GFC_STD_GNU,
+                           "Zero width after L descriptor");
            }
          else
            {
              fmt->saved_token = t;
-             fmt->value = 1;   /* Default width */
-             notify_std (&dtp->common, GFC_STD_GNU, posint_required);
+             notify_std (&dtp->common, GFC_STD_GNU,
+                         "Positive width required with L descriptor");
            }
+         fmt->value = 1;       /* Default width */
        }
-
       get_fnode (fmt, &head, &tail, FMT_L);
       tail->u.n = fmt->value;
       tail->repeat = repeat;