Merge branch 'master' into devel/sphinx

6 files changed, 72 insertions, 26 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index acd60ff..74968c9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,31 @@
+2022-07-31  Harald Anlauf  <anlauf@gmx.de>
+	    Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	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.
+
+2022-07-31  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/77652
+	* check.cc (gfc_check_associated): Make the rank check of POINTER
+	vs. TARGET match the allowed forms of pointer assignment for the
+	selected Fortran standard.
+
+2022-07-29  Tobias Burnus  <tobias@codesourcery.com>
+
+	* openmp.cc (resolve_omp_clauses): Permit assumed-size arrays
+	in uniform clause.
+
 2022-07-26  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/103504
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 91d87a1..1da0b3c 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1502,8 +1502,27 @@ gfc_check_associated (gfc_expr *pointer, gfc_expr *target)
     t = false;
   /* F2018 C838 explicitly allows an assumed-rank variable as the first
      argument of intrinsic inquiry functions.  */
-  if (pointer->rank != -1 && !rank_check (target, 0, pointer->rank))
-    t = false;
+  if (pointer->rank != -1 && pointer->rank != target->rank)
+    {
+      if (pointer->rank == 0 || target->rank == 0)
+	{
+	  /* There exists no valid pointer assignment using bounds
+	     remapping for scalar => array or array => scalar. */
+	  if (!rank_check (target, 0, pointer->rank))
+	    t = false;
+	}
+      else if (target->rank != 1)
+	{
+	  if (!gfc_notify_std (GFC_STD_F2008, "Rank remapping target is not "
+			       "rank 1 at %L", &target->where))
+	    t = false;
+	}
+      else if ((gfc_option.allow_std & GFC_STD_F2003) == 0)
+	{
+	  if (!rank_check (target, 0, pointer->rank))
+	    t = false;
+	}
+    }
   if (target->rank > 0 && target->ref)
     {
       for (i = 0; i < target->rank; i++)
diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc
index 1aa3053..8b8b6e7 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 495c93e..1f53e0c 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/openmp.cc b/gcc/fortran/openmp.cc
index df9cdf4..a7eb6c3 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -7386,7 +7386,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			|| code->op == EXEC_OACC_PARALLEL
 			|| code->op == EXEC_OACC_SERIAL))
 		  check_array_not_assumed (n->sym, n->where, name);
-		else if (n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
+		else if (list != OMP_LIST_UNIFORM
+			 && n->sym->as && n->sym->as->type == AS_ASSUMED_SIZE)
 		  gfc_error ("Assumed size array %qs in %s clause at %L",
 			     n->sym->name, name, &n->where);
 		if (n->sym->attr.in_namelist && !is_reduction)
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc
index 3f01f67..19f2e78 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;