From 443d1195e283af34778bcca151b65bdf65c4d52c Mon Sep 17 00:00:00 2001 From: kargl Date: Mon, 17 Oct 2016 19:57:12 +0000 Subject: [PATCH] 2016-10-17 Steven G. Kargl PR fortran/77978 * match.c (gfc_match_stopcode): Fix error reporting for several deficiencies in matching stop-codes. 2016-10-17 Steven G. Kargl PR fortran/77978 * gfortran.dg/pr77978_1.f90: New test. * gfortran.dg/pr77978_2.f90: Ditto. * gfortran.dg/pr77978_3.f90: Ditto. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@241279 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 6 ++ gcc/fortran/match.c | 106 +++++++++++++++++++++++++++++--- gcc/testsuite/ChangeLog | 7 +++ gcc/testsuite/gfortran.dg/pr77978_1.f90 | 23 +++++++ gcc/testsuite/gfortran.dg/pr77978_2.f90 | 5 ++ gcc/testsuite/gfortran.dg/pr77978_3.f90 | 23 +++++++ 6 files changed, 161 insertions(+), 9 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr77978_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr77978_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/pr77978_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 9b2c5c583f2..ff4ffadeeaa 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2016-10-17 Steven G. Kargl + + PR fortran/77978 + * match.c (gfc_match_stopcode): Fix error reporting for several + deficiencies in matching stop-codes. + 2016-10-17 Paul Thomas PR fortran/61420 diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 9056cb75dac..a19968ba7e8 100644 --- 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 4ba97ca0c2e..7d4a4416e49 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2016-10-17 Steven G. Kargl + + 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 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 index 00000000000..a158f1b7872 --- /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 index 00000000000..d6f2e78cf43 --- /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 index 00000000000..0a3557be64a --- /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 -- 2.11.4.GIT