From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 2071) id E87C13858C2C; Sun, 31 Jul 2022 18:49:58 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E87C13858C2C MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Harald Anlauf To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-1905] Fortran: detect blanks within literal constants in free-form mode [PR92805] X-Act-Checkin: gcc X-Git-Author: Harald Anlauf X-Git-Refname: refs/heads/master X-Git-Oldrev: 0110cfd5449bae3a772f45ea2e4c5dab5b7a8ccd X-Git-Newrev: d325e7048c85e13f12ea79aebf9623eddc7ffcaf Message-Id: <20220731184958.E87C13858C2C@sourceware.org> Date: Sun, 31 Jul 2022 18:49:58 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Sun, 31 Jul 2022 18:49:59 -0000 https://gcc.gnu.org/g:d325e7048c85e13f12ea79aebf9623eddc7ffcaf commit r13-1905-gd325e7048c85e13f12ea79aebf9623eddc7ffcaf Author: Harald Anlauf Date: Thu Jul 28 22:07:02 2022 +0200 Fortran: detect blanks within literal constants in free-form mode [PR92805] gcc/fortran/ChangeLog: PR fortran/92805 * match.cc (gfc_match_small_literal_int): Make gobbling of leading whitespace optional. (gfc_match_name): Likewise. (gfc_match_char): Likewise. * match.h (gfc_match_small_literal_int): Adjust prototype. (gfc_match_name): Likewise. (gfc_match_char): Likewise. * primary.cc (match_kind_param): Match small literal int or name without gobbling whitespace. (get_kind): Do not skip over blanks. (match_string_constant): Likewise. gcc/testsuite/ChangeLog: PR fortran/92805 * gfortran.dg/literal_constants.f: New test. * gfortran.dg/literal_constants.f90: New test. Co-authored-by: Steven G. Kargl Diff: --- gcc/fortran/match.cc | 24 +++++++++++++++--------- gcc/fortran/match.h | 6 +++--- gcc/fortran/primary.cc | 14 +++----------- gcc/testsuite/gfortran.dg/literal_constants.f | 20 ++++++++++++++++++++ gcc/testsuite/gfortran.dg/literal_constants.f90 | 24 ++++++++++++++++++++++++ 5 files changed, 65 insertions(+), 23 deletions(-) diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index 1aa3053e70e..8b8b6e79c8b 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -454,10 +454,11 @@ gfc_match_eos (void) /* Match a literal integer on the input, setting the value on MATCH_YES. Literal ints occur in kind-parameters as well as old-style character length specifications. If cnt is non-NULL it - will be set to the number of digits. */ + will be set to the number of digits. + When gobble_ws is false, do not skip over leading blanks. */ match -gfc_match_small_literal_int (int *value, int *cnt) +gfc_match_small_literal_int (int *value, int *cnt, bool gobble_ws) { locus old_loc; char c; @@ -466,7 +467,8 @@ gfc_match_small_literal_int (int *value, int *cnt) old_loc = gfc_current_locus; *value = -1; - gfc_gobble_whitespace (); + if (gobble_ws) + gfc_gobble_whitespace (); c = gfc_next_ascii_char (); if (cnt) *cnt = 0; @@ -608,17 +610,19 @@ gfc_match_label (void) /* See if the current input looks like a name of some sort. Modifies the passed buffer which must be GFC_MAX_SYMBOL_LEN+1 bytes long. Note that options.cc restricts max_identifier_length to not more - than GFC_MAX_SYMBOL_LEN. */ + than GFC_MAX_SYMBOL_LEN. + When gobble_ws is false, do not skip over leading blanks. */ match -gfc_match_name (char *buffer) +gfc_match_name (char *buffer, bool gobble_ws) { locus old_loc; int i; char c; old_loc = gfc_current_locus; - gfc_gobble_whitespace (); + if (gobble_ws) + gfc_gobble_whitespace (); c = gfc_next_ascii_char (); if (!(ISALPHA (c) || (c == '_' && flag_allow_leading_underscore))) @@ -1053,15 +1057,17 @@ cleanup: /* Tries to match the next non-whitespace character on the input. - This subroutine does not return MATCH_ERROR. */ + This subroutine does not return MATCH_ERROR. + When gobble_ws is false, do not skip over leading blanks. */ match -gfc_match_char (char c) +gfc_match_char (char c, bool gobble_ws) { locus where; where = gfc_current_locus; - gfc_gobble_whitespace (); + if (gobble_ws) + gfc_gobble_whitespace (); if (gfc_next_ascii_char () == c) return MATCH_YES; diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 495c93e0b5c..1f53e0cb67d 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -45,14 +45,14 @@ extern gfc_access gfc_typebound_default_access; match gfc_match_special_char (gfc_char_t *); match gfc_match_space (void); match gfc_match_eos (void); -match gfc_match_small_literal_int (int *, int *); +match gfc_match_small_literal_int (int *, int *, bool = true); match gfc_match_st_label (gfc_st_label **); match gfc_match_small_int (int *); -match gfc_match_name (char *); +match gfc_match_name (char *, bool = true); match gfc_match_symbol (gfc_symbol **, int); match gfc_match_sym_tree (gfc_symtree **, int); match gfc_match_intrinsic_op (gfc_intrinsic_op *); -match gfc_match_char (char); +match gfc_match_char (char, bool = true); match gfc_match (const char *, ...); match gfc_match_iterator (gfc_iterator *, int); match gfc_match_parens (void); diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 3f01f67cd49..19f2e78c8ff 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -45,11 +45,11 @@ match_kind_param (int *kind, int *is_iso_c) *is_iso_c = 0; - m = gfc_match_small_literal_int (kind, NULL); + m = gfc_match_small_literal_int (kind, NULL, false); if (m != MATCH_NO) return m; - m = gfc_match_name (name); + m = gfc_match_name (name, false); if (m != MATCH_YES) return m; @@ -95,7 +95,7 @@ get_kind (int *is_iso_c) *is_iso_c = 0; - if (gfc_match_char ('_') != MATCH_YES) + if (gfc_match_char ('_', false) != MATCH_YES) return -2; m = match_kind_param (&kind, is_iso_c); @@ -1074,17 +1074,9 @@ match_string_constant (gfc_expr **result) c = gfc_next_char (); } - if (c == ' ') - { - gfc_gobble_whitespace (); - c = gfc_next_char (); - } - if (c != '_') goto no_match; - gfc_gobble_whitespace (); - c = gfc_next_char (); if (c != '\'' && c != '"') goto no_match; diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f b/gcc/testsuite/gfortran.dg/literal_constants.f new file mode 100644 index 00000000000..4d1f1b7eb4c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/literal_constants.f @@ -0,0 +1,20 @@ +! { dg-do compile } +! { dg-options "-ffixed-form" } +! PR fortran/92805 - blanks within literal constants in fixed-form mode + + implicit none + integer, parameter :: ck = kind ("a") ! default character kind + integer, parameter :: rk = kind (1.0) ! default real kind + print *, 1_"abc" + print *, 1 _"abc" + print *, 1_ "abc" + print *, ck_"a" + print *, ck _"ab" + print *, ck_ "ab" + print *, 3.1415_4 + print *, 3.1415 _4 + print *, 3.1415_ 4 + print *, 3.1415_rk + print *, 3.1415 _rk + print *, 3.1415_ rk + end diff --git a/gcc/testsuite/gfortran.dg/literal_constants.f90 b/gcc/testsuite/gfortran.dg/literal_constants.f90 new file mode 100644 index 00000000000..f8908f9ad76 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/literal_constants.f90 @@ -0,0 +1,24 @@ +! { dg-do compile } +! { dg-options "-ffree-form" } +! PR fortran/92805 - blanks within literal constants in free-form mode + + implicit none + integer, parameter :: ck = kind ("a") ! default character kind + integer, parameter :: rk = kind (1.0) ! default real kind + print *, 1_"abc" + print *, 1 _"abc" ! { dg-error "Syntax error" } + print *, 1_ "abc" ! { dg-error "Missing kind-parameter" } + print *, 1 _ "abc" ! { dg-error "Syntax error" } + print *, ck_"a" + print *, ck _"ab" ! { dg-error "Syntax error" } + print *, ck_ "ab" ! { dg-error "Syntax error" } + print *, ck _ "ab" ! { dg-error "Syntax error" } + print *, 3.1415_4 + print *, 3.1415 _4 ! { dg-error "Syntax error" } + print *, 3.1415_ 4 ! { dg-error "Missing kind-parameter" } + print *, 3.1415 _ 4 ! { dg-error "Syntax error" } + print *, 3.1415_rk + print *, 3.1415 _rk ! { dg-error "Syntax error" } + print *, 3.1415_ rk ! { dg-error "Missing kind-parameter" } + print *, 3.141 _ rk ! { dg-error "Syntax error" } + end