[gcc r13-1905] Fortran: detect blanks within literal constants in free-form mode [PR92805]

[Harald Anlauf <anlauf@gcc.gnu.org>]

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