public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-1905] Fortran: detect blanks within literal constants in free-form mode [PR92805]
@ 2022-07-31 18:49 Harald Anlauf
0 siblings, 0 replies; only message in thread
From: Harald Anlauf @ 2022-07-31 18:49 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:d325e7048c85e13f12ea79aebf9623eddc7ffcaf
commit r13-1905-gd325e7048c85e13f12ea79aebf9623eddc7ffcaf
Author: Harald Anlauf <anlauf@gmx.de>
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 <kargl@gcc.gnu.org>
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
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-07-31 18:49 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-07-31 18:49 [gcc r13-1905] Fortran: detect blanks within literal constants in free-form mode [PR92805] Harald Anlauf
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).