[gcc/devel/omp/gcc-13] Fortran's gfc_match_char: %S to match symbol with host_assoc

[Tobias Burnus]

https://gcc.gnu.org/g:2b9957c4975d3d5bf50a588208c6f8b37a5092f1

commit 2b9957c4975d3d5bf50a588208c6f8b37a5092f1
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Mon Oct 16 18:12:42 2023 +0200

    Fortran's gfc_match_char: %S to match symbol with host_assoc
    
    gfc_match ("... %s ...", ...) matches a gfc_symbol but with
    host_assoc = 0. This commit adds '%S' as variant which matches
    with host_assoc = 1
    
    gcc/fortran/ChangeLog:
    
            * match.cc (gfc_match_char): Match with '%S' a symbol
            with host_assoc = 1.
    
    (cherry picked from commit 0607e93490058ec31b6ab57078c54771f139b870)

Diff:
---
 gcc/fortran/ChangeLog.omp | 8 ++++++++
 gcc/fortran/match.cc      | 6 ++++--
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 62a33475ee5b..bae90d1e5c1f 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,11 @@
+2023-10-16  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2023-06-20  Tobias Burnus  <tobias@codesourcery.com>
+
+	* match.cc (gfc_match_char): Match with '%S' a symbol
+	with host_assoc = 1.
+
 2023-09-19  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 3db8e0f09691..38a0efed8acc 100644
--- a/gcc/fortran/match.cc
+++ b/gcc/fortran/match.cc
@@ -1084,7 +1084,8 @@ gfc_match_char (char c, bool gobble_ws)
 
    %%  Literal percent sign
    %e  Expression, pointer to a pointer is set
-   %s  Symbol, pointer to the symbol is set
+   %s  Symbol, pointer to the symbol is set (host_assoc = 0)
+   %S  Symbol, pointer to the symbol is set (host_assoc = 1)
    %n  Name, character buffer is set to name
    %t  Matches end of statement.
    %o  Matches an intrinsic operator, returned as an INTRINSIC enum.
@@ -1151,8 +1152,9 @@ loop:
 	  goto loop;
 
 	case 's':
+	case 'S':
 	  vp = va_arg (argp, void **);
-	  n = gfc_match_symbol ((gfc_symbol **) vp, 0);
+	  n = gfc_match_symbol ((gfc_symbol **) vp, c == 'S');
 	  if (n != MATCH_YES)
 	    {
 	      m = n;