This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [PATCH] PR fortran/77978 -- STOP code fixes
On Fri, Oct 14, 2016 at 08:55:10PM -0700, Jerry DeLisle wrote:
> On 10/14/2016 05:24 PM, Steve Kargl wrote:
> > The attach patch fixes a number of shortcomings with
> > STOP codes in gfortran. The updated comment in the
> > code nicely summarizes the problem.
> >
>
> OK and thanks for fix.
>
The attached patch is the version I comitted to trunk.
I broke down an rewrote gfc_match_stopcode to give
proper errors for F95/2003.
--
Steve
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c (revision 241272)
+++ gcc/fortran/match.c (working copy)
@@ -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:
Index: gcc/testsuite/gfortran.dg/pr77978_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77978_1.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77978_1.f90 (working copy)
@@ -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
Index: gcc/testsuite/gfortran.dg/pr77978_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77978_2.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77978_2.f90 (working copy)
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+subroutine a1
+ stop666 ! { dg-error "Blank required in STOP" }
+end subroutine a1
Index: gcc/testsuite/gfortran.dg/pr77978_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr77978_3.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/pr77978_3.f90 (working copy)
@@ -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