Re: [PATCH, v4] Fortran: detect blanks within literal constants in free-form mode [PR92805]

[Harald Anlauf <anlauf@gmx.de>]

[-- Attachment #1: Type: text/plain, Size: 3249 bytes --]

Hi Mikael,

Am 31.07.22 um 10:35 schrieb Mikael Morin:
> Le 30/07/2022 à 21:40, Harald Anlauf a écrit :
>> Hi Mikael,
>>
>> Am 30.07.22 um 10:28 schrieb Mikael Morin:
>>> Meh! We killed one check for gfc_current_form but the other one is still
>>> there.
>>> OK, match_kind_param calls two functions that also gobble space, so
>>> there is work remaining here.
>>> So please make match_small_literal_constant and gfc_match_name
>>> space-gobbling wrappers around space-non-gobbling inner functions and
>>> call those inner functions instead in match_kind_param.
>>
>> well, here's the shortest solution I could come up with.
>> I added a new argument to 3 functions used in parsing that
>> controls the gobbling of whitespace.  We use this to handle
>> whitespace for numerical literals, while the parsing of string
>> literals remains as in the previous version of the patch.
>>
>> This version obviously ignores Thomas' request, as that would
>> require to treat gfc_match_char specially...
>>
>> Regtested again.  OK now?
>
>>     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 in free-form mode.
> I think the "in free-form mode" applied to the preceding patches but can
> be dropped now.
>>     (match_string_constant): Likewise.
>
>> diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
>> index 1aa3053e70e..c0dc0e89361 100644
>> --- a/gcc/fortran/match.cc
>> +++ b/gcc/fortran/match.cc
>> @@ -457,7 +457,7 @@ gfc_match_eos (void)
>>     will be set to the number of digits.  */
> Please add a note about GOBBLE_WS here, like you did for gfc_match_char.
>>
>>  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;
> (...)
>> @@ -611,14 +612,15 @@ gfc_match_label (void)
>>     than GFC_MAX_SYMBOL_LEN.  */
> Same here.
>>
>>  match
>> -gfc_match_name (char *buffer)
>> +gfc_match_name (char *buffer, bool gobble_ws)
>>  {
>>    locus old_loc;
>>    int i;
>>    char c;
>>
> (...)
>> @@ -1052,16 +1054,19 @@ cleanup:
>>  }
>>
>>
>> -/* Tries to match the next non-whitespace character on the input.
>> -   This subroutine does not return MATCH_ERROR.  */
>> +/* Tries to match the next non-whitespace character on the input.  This
>> +   subroutine does not return MATCH_ERROR.  When gobble_ws is false,
>> do not
>> +   skip over leading blanks.
>> +*/
> There should be no line feed before end of comment.

I've adjusted the patch (see attached) and pushed it as

commit r13-1905-gd325e7048c85e13f12ea79aebf9623eddc7ffcaf

Thanks,
Harald

> OK with those changes.
> thanks for your patience.
>
> Mikael
>
>

[-- Attachment #2: pr92805-v5.diff --]
[-- Type: text/x-patch, Size: 7856 bytes --]

From d325e7048c85e13f12ea79aebf9623eddc7ffcaf Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 28 Jul 2022 22:07:02 +0200
Subject: [PATCH] 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>
---
 gcc/fortran/match.cc                          | 24 ++++++++++++-------
 gcc/fortran/match.h                           |  6 ++---
 gcc/fortran/primary.cc                        | 14 +++--------
 gcc/testsuite/gfortran.dg/literal_constants.f | 20 ++++++++++++++++
 .../gfortran.dg/literal_constants.f90         | 24 +++++++++++++++++++
 5 files changed, 65 insertions(+), 23 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f
 create mode 100644 gcc/testsuite/gfortran.dg/literal_constants.f90

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
-- 
2.35.3