===================================================================
@@ -2732,7 +2732,24 @@ gfc_match_cycle (void)
/* Match a number or character constant after an (ERROR) STOP or PAUSE
- statement. */
+ statement. The requirements for a stop-code differs 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 is the same as 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
+*/
static match
gfc_match_stopcode (gfc_statement st)
@@ -2740,6 +2757,27 @@ gfc_match_stopcode (gfc_statement st)
gfc_expr *e;
match m;
+ /* The default selected Standards. */
+ int std = GFC_STD_GNU | GFC_STD_LEGACY | GFC_STD_F77 | GFC_STD_F95
+ | GFC_STD_F95_OBS | GFC_STD_F95_DEL | GFC_STD_F2003
+ | GFC_STD_F2008 | GFC_STD_F2008_OBS | GFC_STD_F2008_TS;
+
+ if (gfc_current_form != FORM_FIXED)
+ {
+ char c;
+
+ c = gfc_peek_ascii_char ();
+
+ if (c != ' '
+ && gfc_option.allow_std != std
+ && (gfc_option.allow_std & GFC_STD_F2008))
+ {
+ gfc_error ("Blank required in %s statement near %C",
+ gfc_ascii_statement (st));
+ return MATCH_ERROR;
+ }
+ }
+
e = NULL;
if (gfc_match_eos () != MATCH_YES)
@@ -2785,6 +2823,15 @@ gfc_match_stopcode (gfc_statement st)
if (e != NULL)
{
+ gfc_simplify_expr (e, 0);
+
+ if (e->expr_type != EXPR_CONSTANT)
+ {
+ gfc_error ("STOP code at %L must be a constant expression",
+ &e->where);
+ goto cleanup;
+ }
+
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 +2841,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,12 +2853,35 @@ 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)
{
- gfc_error ("STOP code at %L must be default integer KIND=%d",
- &e->where, (int) gfc_default_integer_kind);
- goto cleanup;
+ if (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);
+ goto cleanup;
+ }
+
+ if (gfc_option.allow_std != std
+ && (((gfc_option.allow_std & GFC_STD_F95)
+ || (gfc_option.allow_std & GFC_STD_F2003))
+ && !(gfc_option.allow_std & GFC_STD_F2008)))
+ {
+ int n;
+ n = mpz_get_si (e->value.integer);
+ if (n < 0)
+ {
+ gfc_error ("STOP code at %L cannot be negative", &e->where);
+ goto cleanup;
+ }
+
+ if (n > 99999)
+ {
+ gfc_error ("STOP code at %L contains too many digits",
+ &e->where);
+ goto cleanup;
+ }
+ }
}
}
===================================================================
@@ -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
===================================================================
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+subroutine a1
+ stop666 ! { dg-error "Blank required in STOP" }
+end subroutine a1
===================================================================
@@ -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
The attach patch fixes a number of shortcomings with STOP codes in gfortran. The updated comment in the code nicely summarizes the problem. /* Match a number or character constant after an (ERROR) STOP or PAUSE - statement. */ + statement. The requirements for a stop-code differs 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 is the same as 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 +*/ So, the F95/2003 "digit [...]" is not a scalar-int-constant-expr. It sort of looks like a statement label, but of course it is not a statement label as the stop code does label anything. Currently, gfortran parses "digit [...]" as an expression. I've added the necessary checking that "digit [...]" is valid with one exception. For the code program foo stop merge(667, 668, .true.) end gfortran with either -std=f95 or -std=f2003 should reject this code. My patch does not fix this issue, because it would (1) require a complete rewrite of gfc_match_stopcode (which I am not willing to do) and (2) it simply is a vastly unimportant corner case that gives the desired behavior. A second issue raised by John in PR fortran/77978 is that for F95/2003, the following is valid free-form source code: program foo stop666 end but is invalid F2008. The patch fixes this bug, too. OK to commit? 2016-10-XX 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-XX 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.