re PR fortran/77978 (stop codes misinterpreted in both f2003 and f2008)

2016-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/77978
	* match.c (gfc_match_stopcode): Fix error reporting for several
	deficiencies in matching stop-codes.

2016-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/77978
	* gfortran.dg/pr77978_1.f90: New test.
	* gfortran.dg/pr77978_2.f90: Ditto.
	* gfortran.dg/pr77978_3.f90: Ditto.

From-SVN: r241279

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9b2c5c583f25371707d67f46a2b174cce8aa07a5..ff4ffadeeaadc3ea9d6a7c354bdc0a4cb39e7d72 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/77978
+       * match.c (gfc_match_stopcode): Fix error reporting for several
+       deficiencies in matching stop-codes.
+
 2016-10-17  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/61420

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 9056cb75dacbda676f3aeec95cdaabb44118841d..a19968ba7e8a4fe48c58b36c67ab62902987a28c 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -2731,20 +2731,92 @@ gfc_match_cycle (void)
 }
 
 
-/* Match a number or character constant after an (ERROR) STOP or PAUSE
-   statement.  */
+/* Match a stop-code after an (ERROR) STOP or PAUSE statement.  The
+   requirements for a stop-code differ in the standards.
+
+Fortran 95 has
+
+   R840 stop-stmt  is STOP [ stop-code ]
+   R841 stop-code  is scalar-char-constant
+                   or digit [ digit [ digit [ digit [ digit ] ] ] ]
+
+Fortran 2003 matches Fortran 95 except R840 and R841 are now R849 and R850.
+Fortran 2008 has
+
+   R855 stop-stmt     is STOP [ stop-code ]
+   R856 allstop-stmt  is ALL STOP [ stop-code ]
+   R857 stop-code     is scalar-default-char-constant-expr
+                      or scalar-int-constant-expr
+
+For free-form source code, all standards contain a statement of the form:
+
+   A blank shall be used to separate names, constants, or labels from
+   adjacent keywords, names, constants, or labels.
+
+A stop-code is not a name, constant, or label.  So, under Fortran 95 and 2003,
+
+  STOP123
+
+is valid, but it is invalid Fortran 2008.  */
 
 static match
 gfc_match_stopcode (gfc_statement st)
 {
-  gfc_expr *e;
+  gfc_expr *e = NULL;
   match m;
+  bool f95, f03;
 
-  e = NULL;
+  /* Set f95 for -std=f95.  */
+  f95 = gfc_option.allow_std == (GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77
+                                | GFC_STD_F2008_OBS);
+
+  /* Set f03 for -std=f2003.  */
+  f03 = gfc_option.allow_std == (GFC_STD_F95_OBS | GFC_STD_F95 | GFC_STD_F77 
+                                | GFC_STD_F2008_OBS | GFC_STD_F2003);
+
+  /* Look for a blank between STOP and the stop-code for F2008 or later.  */
+  if (gfc_current_form != FORM_FIXED && !(f95 || f03))
+    {
+      char c = gfc_peek_ascii_char ();
+
+      /* Look for end-of-statement.  There is no stop-code.  */
+      if (c == '\n' || c == '!' || c == ';')
+        goto done;
+
+      if (c != ' ')
+       {
+         gfc_error ("Blank required in %s statement near %C",
+                    gfc_ascii_statement (st));
+         return MATCH_ERROR;
+       }
+    }
 
   if (gfc_match_eos () != MATCH_YES)
     {
-      m = gfc_match_init_expr (&e);
+      int stopcode;
+      locus old_locus;
+
+      /* First look for the F95 or F2003 digit [...] construct.  */
+      old_locus = gfc_current_locus;
+      m = gfc_match_small_int (&stopcode);
+      if (m == MATCH_YES && (f95 || f03))
+       {
+         if (stopcode < 0)
+           {
+             gfc_error ("STOP code at %C cannot be negative");
+             return MATCH_ERROR;
+           }
+
+         if (stopcode > 99999)
+           {
+             gfc_error ("STOP code at %C contains too many digits");
+             return MATCH_ERROR;
+           }
+       }
+
+      /* Reset the locus and now load gfc_expr.  */
+      gfc_current_locus = old_locus;
+      m = gfc_match_expr (&e);
       if (m == MATCH_ERROR)
        goto cleanup;
       if (m == MATCH_NO)
@@ -2785,6 +2857,22 @@ gfc_match_stopcode (gfc_statement st)
 
   if (e != NULL)
     {
+      gfc_simplify_expr (e, 0);
+
+      /* Test for F95 and F2003 style STOP stop-code.  */
+      if (e->expr_type != EXPR_CONSTANT && (f95 || f03))
+       {
+         gfc_error ("STOP code at %L must be a scalar CHARACTER constant or "
+                    "digit[digit[digit[digit[digit]]]]", &e->where);
+         goto cleanup;
+       }
+
+      /* Use the machinery for an initialization expression to reduce the
+        stop-code to a constant.  */
+      gfc_init_expr_flag = true;
+      gfc_reduce_init_expr (e);
+      gfc_init_expr_flag = false;
+
       if (!(e->ts.type == BT_CHARACTER || e->ts.type == BT_INTEGER))
        {
          gfc_error ("STOP code at %L must be either INTEGER or CHARACTER type",
@@ -2794,8 +2882,7 @@ gfc_match_stopcode (gfc_statement st)
 
       if (e->rank != 0)
        {
-         gfc_error ("STOP code at %L must be scalar",
-                    &e->where);
+         gfc_error ("STOP code at %L must be scalar", &e->where);
          goto cleanup;
        }
 
@@ -2807,8 +2894,7 @@ gfc_match_stopcode (gfc_statement st)
          goto cleanup;
        }
 
-      if (e->ts.type == BT_INTEGER
-         && e->ts.kind != gfc_default_integer_kind)
+      if (e->ts.type == BT_INTEGER && e->ts.kind != gfc_default_integer_kind)
        {
          gfc_error ("STOP code at %L must be default integer KIND=%d",
                     &e->where, (int) gfc_default_integer_kind);
@@ -2816,6 +2902,8 @@ gfc_match_stopcode (gfc_statement st)
        }
     }
 
+done:
+
   switch (st)
     {
     case ST_STOP:

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4ba97ca0c2e2f296a02ec1c9fe8b550e55e1e1d9..7d4a4416e49af0d0e02fef6ec246d0dd79a22c07 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2016-10-17  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+       PR fortran/77978
+       * gfortran.dg/pr77978_1.f90: New test.
+       * gfortran.dg/pr77978_2.f90: Ditto.
+       * gfortran.dg/pr77978_3.f90: Ditto.
+
 2016-10-17  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/61420

diff --git a/gcc/testsuite/gfortran.dg/pr77978_1.f90 b/gcc/testsuite/gfortran.dg/pr77978_1.f90
new file mode 100644 (file)
index 0000000..a158f1b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr77978_1.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+subroutine a1
+  integer, parameter :: i = -666
+  stop i ! { dg-error "cannot be negative" }
+end subroutine a1
+
+subroutine a2
+  stop -666 ! { dg-error "cannot be negative" }
+end subroutine a2
+
+subroutine a3
+  integer, parameter :: i = 123456
+  stop i ! { dg-error "too many digits" }
+end subroutine a3
+
+subroutine a4
+  stop 123456 ! { dg-error "too many digits" }
+end subroutine a4
+
+!subroutine a5
+!  stop merge(667,668,.true.) 
+!end subroutine a5

diff --git a/gcc/testsuite/gfortran.dg/pr77978_2.f90 b/gcc/testsuite/gfortran.dg/pr77978_2.f90
new file mode 100644 (file)
index 0000000..d6f2e78
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr77978_2.f90
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+subroutine a1
+  stop666 ! { dg-error "Blank required in STOP" }
+end subroutine a1

diff --git a/gcc/testsuite/gfortran.dg/pr77978_3.f90 b/gcc/testsuite/gfortran.dg/pr77978_3.f90
new file mode 100644 (file)
index 0000000..0a3557b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr77978_3.f90
@@ -0,0 +1,23 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+subroutine a1
+  integer, parameter :: i = -666
+  stop i
+end subroutine a1
+
+subroutine a2
+  stop -666
+end subroutine a2
+
+subroutine a3
+  integer, parameter :: i = 123456
+  stop i
+end subroutine a3
+
+subroutine a4
+  stop 123456
+end subroutine a4
+
+subroutine a5
+  stop merge(667,668,.true.) 
+end subroutine a5