From 83855386c41b78c92f4445e4d0e6397372136c90 Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Fri, 19 Mar 2021 20:49:38 +0100
Subject: Add size check to vector-matrix matmul.

It turns out the library version is much faster for vector-matrix
multiplications for large sizes than what inlining can produce.
Use size checks for switching between this and inlining for
that case to.

gcc/fortran/ChangeLog:

	* frontend-passes.c (inline_limit_check): Add rank_a
	argument. If a is rank 1, set the second dimension to 1.
	(inline_matmul_assign): Pass rank_a argument to inline_limit_check.
	(call_external_blas): Likewise.

gcc/testsuite/ChangeLog:

	* gfortran.dg/inline_matmul_6.f90: Adjust count for
	  _gfortran_matmul.
---
 gcc/fortran/frontend-passes.c | 26 ++++++++++++++++++++------
 1 file changed, 20 insertions(+), 6 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index cfc4747..7d3eae6 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -3307,7 +3307,7 @@ get_operand (gfc_intrinsic_op op, gfc_expr *e1, gfc_expr *e2)
    removed by DCE. Only called for rank-two matrices A and B.  */
 
 static gfc_code *
-inline_limit_check (gfc_expr *a, gfc_expr *b, int limit)
+inline_limit_check (gfc_expr *a, gfc_expr *b, int limit, int rank_a)
 {
   gfc_expr *inline_limit;
   gfc_code *if_1, *if_2, *else_2;
@@ -3315,16 +3315,28 @@ inline_limit_check (gfc_expr *a, gfc_expr *b, int limit)
   gfc_typespec ts;
   gfc_expr *cond;
 
+  gcc_assert (rank_a == 1 || rank_a == 2);
+
   /* Calculation is done in real to avoid integer overflow.  */
 
   inline_limit = gfc_get_constant_expr (BT_REAL, gfc_default_real_kind,
 					&a->where);
   mpfr_set_si (inline_limit->value.real, limit, GFC_RND_MODE);
-  mpfr_pow_ui (inline_limit->value.real, inline_limit->value.real, 3,
+
+  /* Set the limit according to the rank.  */
+  mpfr_pow_ui (inline_limit->value.real, inline_limit->value.real, rank_a + 1,
 	       GFC_RND_MODE);
 
   a1 = get_array_inq_function (GFC_ISYM_SIZE, a, 1);
-  a2 = get_array_inq_function (GFC_ISYM_SIZE, a, 2);
+
+  /* For a_rank = 1, must use one as the size of a along the second
+     dimension as to avoid too much code duplication.  */
+
+  if (rank_a == 2)
+    a2 = get_array_inq_function (GFC_ISYM_SIZE, a, 2);
+  else
+    a2 = gfc_get_int_expr (gfc_index_integer_kind, &a->where, 1);
+
   b2 = get_array_inq_function (GFC_ISYM_SIZE, b, 2);
 
   gfc_clear_ts (&ts);
@@ -4243,11 +4255,13 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
   /* Take care of the inline flag.  If the limit check evaluates to a
      constant, dead code elimination will eliminate the unneeded branch.  */
 
-  if (flag_inline_matmul_limit > 0 && matrix_a->rank == 2
+  if (flag_inline_matmul_limit > 0
+      && (matrix_a->rank == 1 || matrix_a->rank == 2)
       && matrix_b->rank == 2)
     {
       if_limit = inline_limit_check (matrix_a, matrix_b,
-				     flag_inline_matmul_limit);
+				     flag_inline_matmul_limit,
+				     matrix_a->rank);
 
       /* Insert the original statement into the else branch.  */
       if_limit->block->block->next = co;
@@ -4757,7 +4771,7 @@ call_external_blas (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
     return 0;
 
   /* Generate the if statement and hang it into the tree.  */
-  if_limit = inline_limit_check (matrix_a, matrix_b, flag_blas_matmul_limit);
+  if_limit = inline_limit_check (matrix_a, matrix_b, flag_blas_matmul_limit, 2);
   co_next = co->next;
   (*current_code) = if_limit;
   co->next = NULL;
-- 
cgit v1.1


From 5f256a70a05fcfc5a1caf56678ceb12b4f87f781 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 20 Mar 2021 00:16:24 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8cc9403..51d4329 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-03-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	* frontend-passes.c (inline_limit_check): Add rank_a
+	argument. If a is rank 1, set the second dimension to 1.
+	(inline_matmul_assign): Pass rank_a argument to inline_limit_check.
+	(call_external_blas): Likewise.
+
 2021-03-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/99345
-- 
cgit v1.1


From 0e792ee11aa6ebb6f61e9ed33eb06e260f0ec703 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 22 Mar 2021 09:49:48 +0100
Subject: Fortran: Fix 'name' bound size [PR99688]

gcc/fortran/ChangeLog:

	PR fortran/99688
	* match.c (select_type_set_tmp, gfc_match_select_type,
	gfc_match_select_rank): Fix 'name' buffersize to avoid out of bounds.
	* resolve.c (resolve_select_type): Likewise.
---
 gcc/fortran/match.c   | 6 +++---
 gcc/fortran/resolve.c | 2 +-
 2 files changed, 4 insertions(+), 4 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 4d5890f..393755e 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -6330,7 +6330,7 @@ select_intrinsic_set_tmp (gfc_typespec *ts)
 static void
 select_type_set_tmp (gfc_typespec *ts)
 {
-  char name[GFC_MAX_SYMBOL_LEN];
+  char name[GFC_MAX_SYMBOL_LEN + 12 + 1];
   gfc_symtree *tmp = NULL;
   gfc_symbol *selector = select_type_stack->selector;
   gfc_symbol *sym;
@@ -6409,7 +6409,7 @@ gfc_match_select_type (void)
 {
   gfc_expr *expr1, *expr2 = NULL;
   match m;
-  char name[GFC_MAX_SYMBOL_LEN];
+  char name[GFC_MAX_SYMBOL_LEN + 1];
   bool class_array;
   gfc_symbol *sym;
   gfc_namespace *ns = gfc_current_ns;
@@ -6634,7 +6634,7 @@ gfc_match_select_rank (void)
 {
   gfc_expr *expr1, *expr2 = NULL;
   match m;
-  char name[GFC_MAX_SYMBOL_LEN];
+  char name[GFC_MAX_SYMBOL_LEN + 1];
   gfc_symbol *sym, *sym2;
   gfc_namespace *ns = gfc_current_ns;
   gfc_array_spec *as = NULL;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 32015c2..715fecd 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9246,7 +9246,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
   gfc_code *class_is = NULL, *default_case = NULL;
   gfc_case *c;
   gfc_symtree *st;
-  char name[GFC_MAX_SYMBOL_LEN];
+  char name[GFC_MAX_SYMBOL_LEN + 12 + 1];
   gfc_namespace *ns;
   int error = 0;
   int rank = 0;
-- 
cgit v1.1


From 8b744f46a2426b6656e52ace697a569795c9153a Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 23 Mar 2021 00:16:25 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 51d4329..ff38399 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-03-22  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/99688
+	* match.c (select_type_set_tmp, gfc_match_select_type,
+	gfc_match_select_rank): Fix 'name' buffersize to avoid out of bounds.
+	* resolve.c (resolve_select_type): Likewise.
+
 2021-03-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	* frontend-passes.c (inline_limit_check): Add rank_a
-- 
cgit v1.1


From 212f4988f37ccf788c8c72b1dc952980bc9be3b7 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 23 Mar 2021 15:45:36 +0100
Subject: Fortran: Fix func decl mismatch [PR93660]

gcc/fortran/ChangeLog:

	PR fortran/93660
	* trans-decl.c (build_function_decl): Add comment;
	increment hidden_typelist for caf_token/caf_offset.
	* trans-types.c (gfc_get_function_type): Add comment;
	add missing caf_token/caf_offset args.

gcc/testsuite/ChangeLog:

	PR fortran/93660
	* gfortran.dg/gomp/declare-simd-coarray-lib.f90: New test.
---
 gcc/fortran/trans-decl.c  |  6 +++++-
 gcc/fortran/trans-types.c | 21 ++++++++++++++++++++-
 2 files changed, 25 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 6a4ed9b..34a0d49 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2488,7 +2488,9 @@ build_function_decl (gfc_symbol * sym, bool global)
 }
 
 
-/* Create the DECL_ARGUMENTS for a procedure.  */
+/* Create the DECL_ARGUMENTS for a procedure.
+   NOTE: The arguments added here must match the argument type created by
+   gfc_get_function_type ().  */
 
 static void
 create_function_arglist (gfc_symbol * sym)
@@ -2807,6 +2809,7 @@ create_function_arglist (gfc_symbol * sym)
 	  DECL_ARG_TYPE (token) = TREE_VALUE (typelist);
 	  TREE_READONLY (token) = 1;
 	  hidden_arglist = chainon (hidden_arglist, token);
+	  hidden_typelist = TREE_CHAIN (hidden_typelist);
 	  gfc_finish_decl (token);
 
 	  offset = build_decl (input_location, PARM_DECL,
@@ -2832,6 +2835,7 @@ create_function_arglist (gfc_symbol * sym)
 	  DECL_ARG_TYPE (offset) = TREE_VALUE (typelist);
 	  TREE_READONLY (offset) = 1;
 	  hidden_arglist = chainon (hidden_arglist, offset);
+	  hidden_typelist = TREE_CHAIN (hidden_typelist);
 	  gfc_finish_decl (offset);
 	}
 
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index ccdc468..bc7aac1 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -3011,6 +3011,10 @@ create_fn_spec (gfc_symbol *sym, tree fntype)
   return build_type_attribute_variant (fntype, tmp);
 }
 
+
+/* NOTE: The returned function type must match the argument list created by
+   create_function_arglist.  */
+
 tree
 gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
 		       const char *fnspec)
@@ -3119,10 +3123,11 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
         }
     }
 
-  /* Add hidden string length parameters.  */
+  /* Add hidden arguments.  */
   for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
     {
       arg = f->sym;
+      /* Add hidden string length parameters.  */
       if (arg && arg->ts.type == BT_CHARACTER && !sym->attr.is_bind_c)
 	{
 	  if (!arg->ts.deferred)
@@ -3145,6 +3150,20 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
 	       && arg->ts.type != BT_CLASS
 	       && !gfc_bt_struct (arg->ts.type))
 	vec_safe_push (typelist, boolean_type_node);
+      /* Coarrays which are descriptorless or assumed-shape pass with
+	 -fcoarray=lib the token and the offset as hidden arguments.  */
+      else if (arg
+	       && flag_coarray == GFC_FCOARRAY_LIB
+	       && ((arg->ts.type != BT_CLASS
+		    && arg->attr.codimension
+		    && !arg->attr.allocatable)
+		   || (arg->ts.type == BT_CLASS
+		       && CLASS_DATA (arg)->attr.codimension
+		       && !CLASS_DATA (arg)->attr.allocatable)))
+	{
+	  vec_safe_push (typelist, pvoid_type_node);  /* caf_token.  */
+	  vec_safe_push (typelist, gfc_array_index_type);  /* caf_offset.  */
+	}
     }
 
   if (!vec_safe_is_empty (typelist)
-- 
cgit v1.1


From bf1f3168f474734400e7a97660d1e7dec664bca9 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 24 Mar 2021 00:16:25 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 8 ++++++++
 1 file changed, 8 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ff38399..94faac5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2021-03-23  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/93660
+	* trans-decl.c (build_function_decl): Add comment;
+	increment hidden_typelist for caf_token/caf_offset.
+	* trans-types.c (gfc_get_function_type): Add comment;
+	add missing caf_token/caf_offset args.
+
 2021-03-22  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/99688
-- 
cgit v1.1


From b179026a5d9fcadadef6ca511933933672557495 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Wed, 24 Mar 2021 07:50:22 +0100
Subject: Fortran: Extend buffer, use snprintf to avoid overflows [PR99369]

gcc/fortran/ChangeLog:

	PR fortran/99369
	* resolve.c (resolve_operator): Make 'msg' buffer larger
	and use snprintf.

gcc/testsuite/ChangeLog:

	PR fortran/99369
	* gfortran.dg/longnames.f90: New test.
---
 gcc/fortran/resolve.c | 82 ++++++++++++++++++++++++++++-----------------------
 1 file changed, 45 insertions(+), 37 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 715fecd..1c9b0c5 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3994,7 +3994,8 @@ static bool
 resolve_operator (gfc_expr *e)
 {
   gfc_expr *op1, *op2;
-  char msg[200];
+  /* One error uses 3 names; additional space for wording (also via gettext). */
+  char msg[3*GFC_MAX_SYMBOL_LEN + 1 + 50];
   bool dual_locus_error;
   bool t = true;
 
@@ -4047,7 +4048,8 @@ resolve_operator (gfc_expr *e)
   if ((op1 && op1->expr_type == EXPR_NULL)
       || (op2 && op2->expr_type == EXPR_NULL))
     {
-      sprintf (msg, _("Invalid context for NULL() pointer at %%L"));
+      snprintf (msg, sizeof (msg),
+		_("Invalid context for NULL() pointer at %%L"));
       goto bad_op;
     }
 
@@ -4063,8 +4065,9 @@ resolve_operator (gfc_expr *e)
 	  break;
 	}
 
-      sprintf (msg, _("Operand of unary numeric operator %%<%s%%> at %%L is %s"),
-	       gfc_op2string (e->value.op.op), gfc_typename (e));
+      snprintf (msg, sizeof (msg),
+		_("Operand of unary numeric operator %%<%s%%> at %%L is %s"),
+		gfc_op2string (e->value.op.op), gfc_typename (e));
       goto bad_op;
 
     case INTRINSIC_PLUS:
@@ -4079,14 +4082,14 @@ resolve_operator (gfc_expr *e)
 	}
 
       if (op1->ts.type == BT_DERIVED || op2->ts.type == BT_DERIVED)
-	sprintf (msg,
-	       _("Unexpected derived-type entities in binary intrinsic "
-		 "numeric operator %%<%s%%> at %%L"),
+	snprintf (msg, sizeof (msg),
+		  _("Unexpected derived-type entities in binary intrinsic "
+		  "numeric operator %%<%s%%> at %%L"),
 	       gfc_op2string (e->value.op.op));
       else
-      	sprintf (msg,
-	       _("Operands of binary numeric operator %%<%s%%> at %%L are %s/%s"),
-	       gfc_op2string (e->value.op.op), gfc_typename (op1),
+	snprintf (msg, sizeof(msg),
+		  _("Operands of binary numeric operator %%<%s%%> at %%L are %s/%s"),
+		  gfc_op2string (e->value.op.op), gfc_typename (op1),
 	       gfc_typename (op2));
       goto bad_op;
 
@@ -4099,9 +4102,9 @@ resolve_operator (gfc_expr *e)
 	  break;
 	}
 
-      sprintf (msg,
-	       _("Operands of string concatenation operator at %%L are %s/%s"),
-	       gfc_typename (op1), gfc_typename (op2));
+      snprintf (msg, sizeof (msg),
+		_("Operands of string concatenation operator at %%L are %s/%s"),
+		gfc_typename (op1), gfc_typename (op2));
       goto bad_op;
 
     case INTRINSIC_AND:
@@ -4142,9 +4145,10 @@ resolve_operator (gfc_expr *e)
 	  goto simplify_op;
 	}
 
-      sprintf (msg, _("Operands of logical operator %%<%s%%> at %%L are %s/%s"),
-	       gfc_op2string (e->value.op.op), gfc_typename (op1),
-	       gfc_typename (op2));
+      snprintf (msg, sizeof (msg),
+		_("Operands of logical operator %%<%s%%> at %%L are %s/%s"),
+		gfc_op2string (e->value.op.op), gfc_typename (op1),
+		gfc_typename (op2));
 
       goto bad_op;
 
@@ -4165,8 +4169,8 @@ resolve_operator (gfc_expr *e)
 	  break;
 	}
 
-      sprintf (msg, _("Operand of .not. operator at %%L is %s"),
-		      gfc_typename (op1));
+      snprintf (msg, sizeof (msg), _("Operand of .not. operator at %%L is %s"),
+		gfc_typename (op1));
       goto bad_op;
 
     case INTRINSIC_GT:
@@ -4276,16 +4280,16 @@ resolve_operator (gfc_expr *e)
 	}
 
       if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
-	sprintf (msg,
-		 _("Logicals at %%L must be compared with %s instead of %s"),
-		 (e->value.op.op == INTRINSIC_EQ
-		  || e->value.op.op == INTRINSIC_EQ_OS)
-		 ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.op));
+	snprintf (msg, sizeof (msg),
+		  _("Logicals at %%L must be compared with %s instead of %s"),
+		  (e->value.op.op == INTRINSIC_EQ
+		   || e->value.op.op == INTRINSIC_EQ_OS)
+		  ? ".eqv." : ".neqv.", gfc_op2string (e->value.op.op));
       else
-	sprintf (msg,
-		 _("Operands of comparison operator %%<%s%%> at %%L are %s/%s"),
-		 gfc_op2string (e->value.op.op), gfc_typename (op1),
-		 gfc_typename (op2));
+	snprintf (msg, sizeof (msg),
+		  _("Operands of comparison operator %%<%s%%> at %%L are %s/%s"),
+		  gfc_op2string (e->value.op.op), gfc_typename (op1),
+		  gfc_typename (op2));
 
       goto bad_op;
 
@@ -4296,19 +4300,23 @@ resolve_operator (gfc_expr *e)
 	  const char *guessed;
 	  guessed = lookup_uop_fuzzy (name, e->value.op.uop->ns->uop_root);
 	  if (guessed)
-	    sprintf (msg, _("Unknown operator %%<%s%%> at %%L; did you mean '%s'?"),
-		name, guessed);
+	    snprintf (msg, sizeof (msg),
+		      _("Unknown operator %%<%s%%> at %%L; did you mean '%s'?"),
+		      name, guessed);
 	  else
-	    sprintf (msg, _("Unknown operator %%<%s%%> at %%L"), name);
+	    snprintf (msg, sizeof (msg), _("Unknown operator %%<%s%%> at %%L"),
+		      name);
 	}
       else if (op2 == NULL)
-	sprintf (msg, _("Operand of user operator %%<%s%%> at %%L is %s"),
-		 e->value.op.uop->name, gfc_typename (op1));
+	snprintf (msg, sizeof (msg),
+		  _("Operand of user operator %%<%s%%> at %%L is %s"),
+		  e->value.op.uop->name, gfc_typename (op1));
       else
 	{
-	  sprintf (msg, _("Operands of user operator %%<%s%%> at %%L are %s/%s"),
-		   e->value.op.uop->name, gfc_typename (op1),
-		   gfc_typename (op2));
+	  snprintf (msg, sizeof (msg),
+		    _("Operands of user operator %%<%s%%> at %%L are %s/%s"),
+		    e->value.op.uop->name, gfc_typename (op1),
+		    gfc_typename (op2));
 	  e->value.op.uop->op->sym->attr.referenced = 1;
 	}
 
@@ -4391,8 +4399,8 @@ resolve_operator (gfc_expr *e)
 
 	      /* Try user-defined operators, and otherwise throw an error.  */
 	      dual_locus_error = true;
-	      sprintf (msg,
-		       _("Inconsistent ranks for operator at %%L and %%L"));
+	      snprintf (msg, sizeof (msg),
+			_("Inconsistent ranks for operator at %%L and %%L"));
 	      goto bad_op;
 	    }
 	}
-- 
cgit v1.1


From 8bf52ffa92f7d1539cbb82fbc0e95389e084ec31 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 25 Mar 2021 00:16:48 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 94faac5..5a7a57a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-03-24  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/99369
+	* resolve.c (resolve_operator): Make 'msg' buffer larger
+	and use snprintf.
+
 2021-03-23  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/93660
-- 
cgit v1.1


From 9d45e848d02e71c11420ec49630281e9a29c89b8 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 26 Mar 2021 08:39:24 +0100
Subject: Fortran: Fix intrinsic null() handling [PR99651]

gcc/fortran/ChangeLog:

	PR fortran/99651
	* intrinsic.c (gfc_intrinsic_func_interface): Set
	attr.proc = PROC_INTRINSIC if FL_PROCEDURE.

gcc/testsuite/ChangeLog:

	PR fortran/99651
	* gfortran.dg/null_11.f90: New test.
---
 gcc/fortran/intrinsic.c | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index e68eff8..17fd92e 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -5071,6 +5071,11 @@ got_specific:
       sym->attr.intrinsic = 1;
       sym->attr.flavor = FL_PROCEDURE;
     }
+  if (sym->attr.flavor == FL_PROCEDURE)
+    {
+      sym->attr.function = 1;
+      sym->attr.proc = PROC_INTRINSIC;
+    }
 
   if (!sym->module)
     gfc_intrinsic_symbol (sym);
-- 
cgit v1.1


From 651684b462f979a4e70a668c4c9767a5fd7d223a Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 27 Mar 2021 00:16:27 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5a7a57a..b3cda93 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-03-26  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/99651
+	* intrinsic.c (gfc_intrinsic_func_interface): Set
+	attr.proc = PROC_INTRINSIC if FL_PROCEDURE.
+
 2021-03-24  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/99369
-- 
cgit v1.1


From 01685676a9309bc0b8b2f4697c23bd6aa0e00d5d Mon Sep 17 00:00:00 2001
From: Steve Kargl <kargl@gcc.gnu.org>
Date: Sat, 27 Mar 2021 15:02:16 -0700
Subject: fortran: Fix off-by-one in buffer sizes.

gcc/fortran/ChangeLog:

	* misc.c (gfc_typename): Fix off-by-one in buffer sizes.
---
 gcc/fortran/misc.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.c
index 8a96243..3d449ae1 100644
--- a/gcc/fortran/misc.c
+++ b/gcc/fortran/misc.c
@@ -124,8 +124,10 @@ gfc_basic_typename (bt type)
 const char *
 gfc_typename (gfc_typespec *ts, bool for_hash)
 {
-  static char buffer1[GFC_MAX_SYMBOL_LEN + 7];  /* 7 for "TYPE()" + '\0'.  */
-  static char buffer2[GFC_MAX_SYMBOL_LEN + 7];
+  /* Need to add sufficient padding for "TYPE()" + '\0', "UNION()" + '\0',
+     or "CLASS()" + '\0'.  */
+  static char buffer1[GFC_MAX_SYMBOL_LEN + 8];
+  static char buffer2[GFC_MAX_SYMBOL_LEN + 8];
   static int flag = 0;
   char *buffer;
   gfc_typespec *ts1;
-- 
cgit v1.1


From d21001c793e97d88013d05226a8ea93a149726b1 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sun, 28 Mar 2021 00:16:17 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 4 ++++
 1 file changed, 4 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b3cda93..40457ea 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,7 @@
+2021-03-27  Steve Kargl  <kargl@gcc.gnu.org>
+
+	* misc.c (gfc_typename): Fix off-by-one in buffer sizes.
+
 2021-03-26  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/99651
-- 
cgit v1.1


From 297363774e6a5dca2f46a85ab086f1d9e59431ac Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Sun, 28 Mar 2021 16:48:27 +0100
Subject: Fortran: Fix problem with runtime pointer check [PR99602].

2021-03-28  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran/ChangeLog

	PR fortran/99602
	* trans-expr.c (gfc_conv_procedure_call): Use the _data attrs
	for class expressions and detect proc pointer evaluations by
	the non-null actual argument list.

gcc/testsuite/ChangeLog

	PR fortran/99602
	* gfortran.dg/pr99602.f90: New test.
	* gfortran.dg/pr99602a.f90: New test.
	* gfortran.dg/pr99602b.f90: New test.
	* gfortran.dg/pr99602c.f90: New test.
	* gfortran.dg/pr99602d.f90: New test.
---
 gcc/fortran/trans-expr.c | 28 ++++++++++++++++++++--------
 1 file changed, 20 insertions(+), 8 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index bffe080..2fa17b3 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6663,6 +6663,18 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	  char *msg;
 	  tree cond;
 	  tree tmp;
+	  symbol_attribute fsym_attr;
+
+	  if (fsym)
+	    {
+	      if (fsym->ts.type == BT_CLASS)
+		{
+		  fsym_attr = CLASS_DATA (fsym)->attr;
+		  fsym_attr.pointer = fsym_attr.class_pointer;
+		}
+	      else
+		fsym_attr = fsym->attr;
+	    }
 
 	  if (e->expr_type == EXPR_VARIABLE || e->expr_type == EXPR_FUNCTION)
 	    attr = gfc_expr_attr (e);
@@ -6685,17 +6697,17 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      tree present, null_ptr, type;
 
 	      if (attr.allocatable
-		  && (fsym == NULL || !fsym->attr.allocatable))
+		  && (fsym == NULL || !fsym_attr.allocatable))
 		msg = xasprintf ("Allocatable actual argument '%s' is not "
 				 "allocated or not present",
 				 e->symtree->n.sym->name);
 	      else if (attr.pointer
-		       && (fsym == NULL || !fsym->attr.pointer))
+		       && (fsym == NULL || !fsym_attr.pointer))
 		msg = xasprintf ("Pointer actual argument '%s' is not "
 				 "associated or not present",
 				 e->symtree->n.sym->name);
-	      else if (attr.proc_pointer
-		       && (fsym == NULL || !fsym->attr.proc_pointer))
+	      else if (attr.proc_pointer && !e->value.function.actual
+		       && (fsym == NULL || !fsym_attr.proc_pointer))
 		msg = xasprintf ("Proc-pointer actual argument '%s' is not "
 				 "associated or not present",
 				 e->symtree->n.sym->name);
@@ -6719,15 +6731,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
           else
 	    {
 	      if (attr.allocatable
-		  && (fsym == NULL || !fsym->attr.allocatable))
+		  && (fsym == NULL || !fsym_attr.allocatable))
 		msg = xasprintf ("Allocatable actual argument '%s' is not "
 				 "allocated", e->symtree->n.sym->name);
 	      else if (attr.pointer
-		       && (fsym == NULL || !fsym->attr.pointer))
+		       && (fsym == NULL || !fsym_attr.pointer))
 		msg = xasprintf ("Pointer actual argument '%s' is not "
 				 "associated", e->symtree->n.sym->name);
-	      else if (attr.proc_pointer
-		       && (fsym == NULL || !fsym->attr.proc_pointer))
+	      else if (attr.proc_pointer && !e->value.function.actual
+		       && (fsym == NULL || !fsym_attr.proc_pointer))
 		msg = xasprintf ("Proc-pointer actual argument '%s' is not "
 				 "associated", e->symtree->n.sym->name);
 	      else
-- 
cgit v1.1


From c411011287f707d42fd582a01de2ed0d36867211 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Mon, 29 Mar 2021 00:16:20 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 40457ea..d6c8c38 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-03-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/99602
+	* trans-expr.c (gfc_conv_procedure_call): Use the _data attrs
+	for class expressions and detect proc pointer evaluations by
+	the non-null actual argument list.
+
 2021-03-27  Steve Kargl  <kargl@gcc.gnu.org>
 
 	* misc.c (gfc_typename): Fix off-by-one in buffer sizes.
-- 
cgit v1.1


From d7cef070bf43bfb3f3d77bac42eadea06c4b0281 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 1 Apr 2021 07:49:32 +0200
Subject: PR fortran/99840 - ICE in gfc_simplify_matmul, at
 fortran/simplify.c:4777

The simplification of the transposition of a constant array shall properly
initialize and set the shape of the result.

gcc/fortran/ChangeLog:

	PR fortran/99840
	* simplify.c (gfc_simplify_transpose): Properly initialize
	resulting shape.

gcc/testsuite/ChangeLog:

	PR fortran/99840
	* gfortran.dg/transpose_5.f90: New test.
---
 gcc/fortran/simplify.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 388aca7..c27b47a 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -8123,8 +8123,8 @@ gfc_simplify_transpose (gfc_expr *matrix)
 			       &matrix->where);
   result->rank = 2;
   result->shape = gfc_get_shape (result->rank);
-  mpz_set (result->shape[0], matrix->shape[1]);
-  mpz_set (result->shape[1], matrix->shape[0]);
+  mpz_init_set (result->shape[0], matrix->shape[1]);
+  mpz_init_set (result->shape[1], matrix->shape[0]);
 
   if (matrix->ts.type == BT_CHARACTER)
     result->ts.u.cl = matrix->ts.u.cl;
-- 
cgit v1.1


From f1607029aea3043f7bd4f86c005e0997795f5ffd Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 2 Apr 2021 00:16:26 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d6c8c38..d8ca13f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-04-01  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/99840
+	* simplify.c (gfc_simplify_transpose): Properly initialize
+	resulting shape.
+
 2021-03-28  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/99602
-- 
cgit v1.1


From fc27115d6107f219e6f3dc610c99210005fe9dc5 Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Sat, 3 Apr 2021 12:49:50 +0100
Subject: Fortran: Fix ICE on wrong code [PR99818].

2021-04-03  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran/ChangeLog

	PR fortran/99818
	* interface.c (compare_parameter): The codimension attribute is
	applied to the _data field of class formal arguments.

gcc/testsuite/ChangeLog

	PR fortran/99818
	* gfortran.dg/coarray_48.f90: New test.
---
 gcc/fortran/interface.c | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f7ca52e..6073612 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2327,6 +2327,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
   bool rank_check, is_pointer;
   char err[200];
   gfc_component *ppc;
+  bool codimension = false;
 
   /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
      procs c_f_pointer or c_f_procpointer, and we need to accept most
@@ -2490,7 +2491,12 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       return false;
     }
 
-  if (formal->attr.codimension && !gfc_is_coarray (actual))
+  if (formal->ts.type == BT_CLASS && formal->attr.class_ok)
+    codimension = CLASS_DATA (formal)->attr.codimension;
+  else
+    codimension = formal->attr.codimension;
+
+  if (codimension && !gfc_is_coarray (actual))
     {
       if (where)
 	gfc_error ("Actual argument to %qs at %L must be a coarray",
@@ -2498,7 +2504,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       return false;
     }
 
-  if (formal->attr.codimension && formal->attr.allocatable)
+  if (codimension && formal->attr.allocatable)
     {
       gfc_ref *last = NULL;
 
@@ -2520,7 +2526,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 	}
     }
 
-  if (formal->attr.codimension)
+  if (codimension)
     {
       /* F2008, 12.5.2.8 + Corrig 2 (IR F08/0048).  */
       /* F2018, 12.5.2.8.  */
@@ -2586,7 +2592,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       return false;
     }
 
-  if (formal->attr.allocatable && !formal->attr.codimension
+  if (formal->attr.allocatable && !codimension
       && actual_attr.codimension)
     {
       if (formal->attr.intent == INTENT_OUT)
-- 
cgit v1.1


From c0756c4eb36b6bf4bf1ea0cf3633f08ae0e1c13d Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sun, 4 Apr 2021 00:16:26 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d8ca13f..8ab3316 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-04-03  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/99818
+	* interface.c (compare_parameter): The codimension attribute is
+	applied to the _data field of class formal arguments.
+
 2021-04-01  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/99840
-- 
cgit v1.1


From d31f485dedc86773152d0384bc6ba5583b259a42 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 9 Apr 2021 10:18:24 +0200
Subject: Fortran: Fix fndecl with -fcoarray=lib [PR99817]

gcc/fortran/ChangeLog:

	PR fortran/99817
	* trans-types.c (gfc_get_function_type): Also generate hidden
	coarray argument for character arguments.

gcc/testsuite/ChangeLog:

	PR fortran/99817
	* gfortran.dg/coarray/dummy_2.f90: New test.
---
 gcc/fortran/trans-types.c | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index bc7aac1..9f21b3e 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -3152,14 +3152,14 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
 	vec_safe_push (typelist, boolean_type_node);
       /* Coarrays which are descriptorless or assumed-shape pass with
 	 -fcoarray=lib the token and the offset as hidden arguments.  */
-      else if (arg
-	       && flag_coarray == GFC_FCOARRAY_LIB
-	       && ((arg->ts.type != BT_CLASS
-		    && arg->attr.codimension
-		    && !arg->attr.allocatable)
-		   || (arg->ts.type == BT_CLASS
-		       && CLASS_DATA (arg)->attr.codimension
-		       && !CLASS_DATA (arg)->attr.allocatable)))
+      if (arg
+	  && flag_coarray == GFC_FCOARRAY_LIB
+	  && ((arg->ts.type != BT_CLASS
+	       && arg->attr.codimension
+	       && !arg->attr.allocatable)
+	      || (arg->ts.type == BT_CLASS
+		  && CLASS_DATA (arg)->attr.codimension
+		  && !CLASS_DATA (arg)->attr.allocatable)))
 	{
 	  vec_safe_push (typelist, pvoid_type_node);  /* caf_token.  */
 	  vec_safe_push (typelist, gfc_array_index_type);  /* caf_offset.  */
-- 
cgit v1.1


From 3115aba8d856faadaab5c79bc4823a39ebc21bb2 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 10 Apr 2021 00:16:23 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8ab3316..8fc1159 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-04-09  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/99817
+	* trans-types.c (gfc_get_function_type): Also generate hidden
+	coarray argument for character arguments.
+
 2021-04-03  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/99818
-- 
cgit v1.1


From e4fd26d647ee526f11e8ca8d59536d2f67119b9a Mon Sep 17 00:00:00 2001
From: Martin Liska <mliska@suse.cz>
Date: Mon, 12 Apr 2021 16:43:37 +0200
Subject: docs: Remove empty table column.

gcc/fortran/ChangeLog:

	* intrinsic.texi: The table has first column empty and it makes
	trouble when processing makeinfo --xml output.
---
 gcc/fortran/intrinsic.texi | 34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 73baa34..a625087 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -4764,15 +4764,15 @@ Unavailable time and date parameters return blanks.
 
 @var{VALUES} is @code{INTENT(OUT)} and provides the following:
 
-@multitable @columnfractions .15 .30 .40
-@item @tab @code{VALUE(1)}: @tab The year
-@item @tab @code{VALUE(2)}: @tab The month
-@item @tab @code{VALUE(3)}: @tab The day of the month
-@item @tab @code{VALUE(4)}: @tab Time difference with UTC in minutes
-@item @tab @code{VALUE(5)}: @tab The hour of the day
-@item @tab @code{VALUE(6)}: @tab The minutes of the hour
-@item @tab @code{VALUE(7)}: @tab The seconds of the minute
-@item @tab @code{VALUE(8)}: @tab The milliseconds of the second
+@multitable @columnfractions .15 .70
+@item @code{VALUE(1)}: @tab The year
+@item @code{VALUE(2)}: @tab The month
+@item @code{VALUE(3)}: @tab The day of the month
+@item @code{VALUE(4)}: @tab Time difference with UTC in minutes
+@item @code{VALUE(5)}: @tab The hour of the day
+@item @code{VALUE(6)}: @tab The minutes of the hour
+@item @code{VALUE(7)}: @tab The seconds of the minute
+@item @code{VALUE(8)}: @tab The milliseconds of the second
 @end multitable
 
 @item @emph{Standard}:
@@ -5278,10 +5278,10 @@ only one form can be used in any given program unit.
 
 @var{VALUES} and @var{TIME} are @code{INTENT(OUT)} and provide the following:
 
-@multitable @columnfractions .15 .30 .40
-@item @tab @code{VALUES(1)}: @tab User time in seconds.
-@item @tab @code{VALUES(2)}: @tab System time in seconds.
-@item @tab @code{TIME}: @tab Run time since start in seconds.
+@multitable @columnfractions .15 .70
+@item @code{VALUES(1)}: @tab User time in seconds.
+@item @code{VALUES(2)}: @tab System time in seconds.
+@item @code{TIME}: @tab Run time since start in seconds.
 @end multitable
 
 @item @emph{Standard}:
@@ -5587,10 +5587,10 @@ only one form can be used in any given program unit.
 
 @var{VALUES} and @var{TIME} are @code{INTENT(OUT)} and provide the following:
 
-@multitable @columnfractions .15 .30 .60
-@item @tab @code{VALUES(1)}: @tab User time in seconds.
-@item @tab @code{VALUES(2)}: @tab System time in seconds.
-@item @tab @code{TIME}: @tab Run time since start in seconds.
+@multitable @columnfractions .15 .70
+@item @code{VALUES(1)}: @tab User time in seconds.
+@item @code{VALUES(2)}: @tab System time in seconds.
+@item @code{TIME}: @tab Run time since start in seconds.
 @end multitable
 
 @item @emph{Standard}:
-- 
cgit v1.1


From df3b1289521e6f24d5151fc5f7b135b8bf3009bc Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 15 Apr 2021 00:16:47 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8fc1159..1f8578c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2021-04-14  Martin Liska  <mliska@suse.cz>
+
+	* intrinsic.texi: The table has first column empty and it makes
+	trouble when processing makeinfo --xml output.
+
 2021-04-09  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/99817
-- 
cgit v1.1


From 9a0e09f3dd5339bb18cc47317f2298d9157ced29 Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Thu, 15 Apr 2021 07:34:26 +0100
Subject: Fortran: Fix class reallocate on assignment [PR99307].

2021-04-15  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/99307
	* symbol.c: Remove trailing white space.
	* trans-array.c (gfc_trans_create_temp_array): Create a class
	temporary for class expressions and assign the new descriptor
	to the data field.
	(build_class_array_ref): If the class expr can be extracted,
	then use that for 'decl'. Class function results are reliably
	handled this way. Call gfc_find_and_cut_at_last_class_ref to
	eliminate largely redundant code. Remove dead code and recast
	the rest of the code to extract 'decl' for remaining cases.
	Call gfc_build_spanned_array_ref.
	(gfc_alloc_allocatable_for_assignment): Use class descriptor
	element length for 'elemsize1'. Eliminate repeat set of dtype
	for class expressions.
	* trans-expr.c (gfc_find_and_cut_at_last_class_ref): Include
	additional code from build_class_array_ref, and use optional
	gfc_typespec pointer argument.
	(gfc_trans_scalar_assign): Make use of pre and post blocks for
	all class expressions.
	* trans.c (get_array_span): For unlimited polymorphic exprs
	multiply the span by the value of the _len field.
	(gfc_build_spanned_array_ref): New function.
	(gfc_build_array_ref): Call gfc_build_spanned_array_ref and
	eliminate repeated code.
	* trans.h: Add arg to gfc_find_and_cut_at_last_class_ref and
	add prototype for gfc_build_spanned_array_ref.
---
 gcc/fortran/symbol.c      |   2 +-
 gcc/fortran/trans-array.c | 204 ++++++++++++++++++----------------------------
 gcc/fortran/trans-expr.c  |  98 +++++++++++++++-------
 gcc/fortran/trans.c       |  36 +++++---
 gcc/fortran/trans.h       |   6 +-
 5 files changed, 177 insertions(+), 169 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index e982374..6d61bf4 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -4391,7 +4391,7 @@ get_iso_c_binding_dt (int sym_id)
 	  if (dt_list->from_intmod != INTMOD_NONE
 	      && dt_list->intmod_sym_id == sym_id)
 	    return dt_list;
-	
+
 	  dt_list = dt_list->dt_next;
 	}
     }
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be5eb89..ca90142 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1403,9 +1403,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   desc = gfc_create_var (type, "atmp");
   GFC_DECL_PACKED_ARRAY (desc) = 1;
 
-  info->descriptor = desc;
-  size = gfc_index_one_node;
-
   /* Emit a DECL_EXPR for the variable sized array type in
      GFC_TYPE_ARRAY_DATAPTR_TYPE so the gimplification of its type
      sizes works correctly.  */
@@ -1416,9 +1413,40 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
   gfc_add_expr_to_block (pre, build1 (DECL_EXPR,
 				      arraytype, TYPE_NAME (arraytype)));
 
-  /* Fill in the array dtype.  */
-  tmp = gfc_conv_descriptor_dtype (desc);
-  gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+  if (class_expr != NULL_TREE)
+    {
+      tree class_data;
+      tree dtype;
+
+      /* Create a class temporary.  */
+      tmp = gfc_create_var (TREE_TYPE (class_expr), "ctmp");
+      gfc_add_modify (pre, tmp, class_expr);
+
+      /* Assign the new descriptor to the _data field. This allows the
+	 vptr _copy to be used for scalarized assignment since the class
+	 temporary can be found from the descriptor.  */
+      class_data = gfc_class_data_get (tmp);
+      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+			     TREE_TYPE (desc), desc);
+      gfc_add_modify (pre, class_data, tmp);
+
+      /* Take the dtype from the class expression.  */
+      dtype = gfc_conv_descriptor_dtype (gfc_class_data_get (class_expr));
+      tmp = gfc_conv_descriptor_dtype (class_data);
+      gfc_add_modify (pre, tmp, dtype);
+
+      /* Point desc to the class _data field.  */
+      desc = class_data;
+    }
+  else
+    {
+      /* Fill in the array dtype.  */
+      tmp = gfc_conv_descriptor_dtype (desc);
+      gfc_add_modify (pre, tmp, gfc_get_dtype (TREE_TYPE (desc)));
+    }
+
+  info->descriptor = desc;
+  size = gfc_index_one_node;
 
   /*
      Fill in the bounds and stride.  This is a packed array, so:
@@ -3424,134 +3452,73 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int dim, int i,
 static bool
 build_class_array_ref (gfc_se *se, tree base, tree index)
 {
-  tree type;
   tree size;
-  tree offset;
   tree decl = NULL_TREE;
   tree tmp;
   gfc_expr *expr = se->ss->info->expr;
-  gfc_ref *ref;
-  gfc_ref *class_ref = NULL;
+  gfc_expr *class_expr;
   gfc_typespec *ts;
+  gfc_symbol *sym;
 
-  if (se->expr && DECL_P (se->expr) && DECL_LANG_SPECIFIC (se->expr)
-      && GFC_DECL_SAVED_DESCRIPTOR (se->expr)
-      && GFC_CLASS_TYPE_P (TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (se->expr))))
-    decl = se->expr;
+  tmp = !VAR_P (base) ? gfc_get_class_from_expr (base) : NULL_TREE;
+
+  if (tmp != NULL_TREE)
+    decl = tmp;
   else
     {
-      if (expr == NULL
+      /* The base expression does not contain a class component, either
+	 because it is a temporary array or array descriptor.  Class
+	 array functions are correctly resolved above.  */
+      if (!expr
 	  || (expr->ts.type != BT_CLASS
-	      && !gfc_is_class_array_function (expr)
 	      && !gfc_is_class_array_ref (expr, NULL)))
 	return false;
 
-      if (expr->symtree && expr->symtree->n.sym->ts.type == BT_CLASS)
-	ts = &expr->symtree->n.sym->ts;
-      else
-	ts = NULL;
-
-      for (ref = expr->ref; ref; ref = ref->next)
-	{
-	  if (ref->type == REF_COMPONENT
-	      && ref->u.c.component->ts.type == BT_CLASS
-	      && ref->next && ref->next->type == REF_COMPONENT
-	      && strcmp (ref->next->u.c.component->name, "_data") == 0
-	      && ref->next->next
-	      && ref->next->next->type == REF_ARRAY
-	      && ref->next->next->u.ar.type != AR_ELEMENT)
-	    {
-	      ts = &ref->u.c.component->ts;
-	      class_ref = ref;
-	      break;
-	    }
-	}
+      /* Obtain the expression for the class entity or component that is
+	 followed by an array reference, which is not an element, so that
+	 the span of the array can be obtained.  */
+      class_expr = gfc_find_and_cut_at_last_class_ref (expr, false, &ts);
 
-      if (ts == NULL)
+      if (!ts)
 	return false;
-    }
 
-  if (class_ref == NULL && expr && expr->symtree->n.sym->attr.function
-      && expr->symtree->n.sym == expr->symtree->n.sym->result
-      && expr->symtree->n.sym->backend_decl == current_function_decl)
-    {
-      decl = gfc_get_fake_result_decl (expr->symtree->n.sym, 0);
-    }
-  else if (expr && gfc_is_class_array_function (expr))
-    {
-      size = NULL_TREE;
-      decl = NULL_TREE;
-      for (tmp = base; tmp; tmp = TREE_OPERAND (tmp, 0))
-	{
-	  tree type;
-	  type = TREE_TYPE (tmp);
-	  while (type)
-	    {
-	      if (GFC_CLASS_TYPE_P (type))
-		decl = tmp;
-	      if (type != TYPE_CANONICAL (type))
-		type = TYPE_CANONICAL (type);
-	      else
-		type = NULL_TREE;
-	    }
-	  if (VAR_P (tmp))
-	    break;
+      sym = (!class_expr && expr) ? expr->symtree->n.sym : NULL;
+      if (sym && sym->attr.function
+	  && sym == sym->result
+	  && sym->backend_decl == current_function_decl)
+	/* The temporary is the data field of the class data component
+	   of the current function.  */
+	decl = gfc_get_fake_result_decl (sym, 0);
+      else if (sym)
+	{
+	  if (decl == NULL_TREE)
+	    decl = expr->symtree->n.sym->backend_decl;
+	  /* For class arrays the tree containing the class is stored in
+	     GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
+	     For all others it's sym's backend_decl directly.  */
+	  if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
+	    decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
 	}
+      else
+	decl = gfc_get_class_from_gfc_expr (class_expr);
 
-      if (decl == NULL_TREE)
-	return false;
+      if (POINTER_TYPE_P (TREE_TYPE (decl)))
+	decl = build_fold_indirect_ref_loc (input_location, decl);
 
-      se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
-    }
-  else if (class_ref == NULL)
-    {
-      if (decl == NULL_TREE)
-	decl = expr->symtree->n.sym->backend_decl;
-      /* For class arrays the tree containing the class is stored in
-	 GFC_DECL_SAVED_DESCRIPTOR of the sym's backend_decl.
-	 For all others it's sym's backend_decl directly.  */
-      if (DECL_LANG_SPECIFIC (decl) && GFC_DECL_SAVED_DESCRIPTOR (decl))
-	decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
-    }
-  else
-    {
-      /* Remove everything after the last class reference, convert the
-	 expression and then recover its tailend once more.  */
-      gfc_se tmpse;
-      ref = class_ref->next;
-      class_ref->next = NULL;
-      gfc_init_se (&tmpse, NULL);
-      gfc_conv_expr (&tmpse, expr);
-      gfc_add_block_to_block (&se->pre, &tmpse.pre);
-      decl = tmpse.expr;
-      class_ref->next = ref;
+      if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
+	return false;
     }
 
-  if (POINTER_TYPE_P (TREE_TYPE (decl)))
-    decl = build_fold_indirect_ref_loc (input_location, decl);
-
-  if (!GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
-    return false;
+  se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
 
   size = gfc_class_vtab_size_get (decl);
-
   /* For unlimited polymorphic entities then _len component needs to be
      multiplied with the size.  */
   size = gfc_resize_class_size_with_len (&se->pre, decl, size);
-
   size = fold_convert (TREE_TYPE (index), size);
 
-  /* Build the address of the element.  */
-  type = TREE_TYPE (TREE_TYPE (base));
-  offset = fold_build2_loc (input_location, MULT_EXPR,
-			    gfc_array_index_type,
-			    index, size);
-  tmp = gfc_build_addr_expr (pvoid_type_node, base);
-  tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
-  tmp = fold_convert (build_pointer_type (type), tmp);
-
   /* Return the element in the se expression.  */
-  se->expr = build_fold_indirect_ref_loc (input_location, tmp);
+  se->expr = gfc_build_spanned_array_ref (base, index, size);
   return true;
 }
 
@@ -10280,23 +10247,10 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
     }
   else if (expr1->ts.type == BT_CLASS)
     {
-      tmp = expr1->rank ? gfc_get_class_from_expr (desc) : NULL_TREE;
-      if (tmp == NULL_TREE)
-	tmp = gfc_get_class_from_gfc_expr (expr1);
-
-      if (tmp != NULL_TREE)
-	{
-	  tmp2 = gfc_class_vptr_get (tmp);
-	  cond = fold_build2_loc (input_location, NE_EXPR,
-				  logical_type_node, tmp2,
-				  build_int_cst (TREE_TYPE (tmp2), 0));
-	  elemsize1 = gfc_class_vtab_size_get (tmp);
-	  elemsize1 = fold_build3_loc (input_location, COND_EXPR,
-				      gfc_array_index_type, cond,
-				      elemsize1, gfc_index_zero_node);
-	}
-      else
-	elemsize1 = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&CLASS_DATA (expr1)->ts));
+      /* Unfortunately, the lhs vptr is set too early in many cases.
+	 Play it safe by using the descriptor element length.  */
+      tmp = gfc_conv_descriptor_elem_len (desc);
+      elemsize1 = fold_convert (gfc_array_index_type, tmp);
     }
   else
     elemsize1 = NULL_TREE;
@@ -10770,11 +10724,11 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
 
 
   /* We already set the dtype in the case of deferred character
-     length arrays and unlimited polymorphic arrays.  */
+     length arrays and class lvalues.  */
   if (!(GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))
 	&& ((expr1->ts.type == BT_CHARACTER && expr1->ts.deferred)
 	    || coarray))
-      && !UNLIMITED_POLY (expr1))
+      && expr1->ts.type != BT_CLASS)
     {
       tmp = gfc_conv_descriptor_dtype (desc);
       gfc_add_modify (&alloc_block, tmp, gfc_get_dtype (TREE_TYPE (desc)));
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 2fa17b3..213f32b 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -380,15 +380,20 @@ gfc_vptr_size_get (tree vptr)
 #undef VTABLE_FINAL_FIELD
 
 
-/* Search for the last _class ref in the chain of references of this
-   expression and cut the chain there.  Albeit this routine is similiar
-   to class.c::gfc_add_component_ref (), is there a significant
-   difference: gfc_add_component_ref () concentrates on an array ref to
-   be the last ref in the chain.  This routine is oblivious to the kind
-   of refs following.  */
+/* IF ts is null (default), search for the last _class ref in the chain
+   of references of the expression and cut the chain there.  Although
+   this routine is similiar to class.c:gfc_add_component_ref (), there
+   is a significant difference: gfc_add_component_ref () concentrates
+   on an array ref that is the last ref in the chain and is oblivious
+   to the kind of refs following.
+   ELSE IF ts is non-null the cut is at the class entity or component
+   that is followed by an array reference, which is not an element.
+   These calls come from trans-array.c:build_class_array_ref, which
+   handles scalarized class array references.*/
 
 gfc_expr *
-gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold)
+gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold,
+				    gfc_typespec **ts)
 {
   gfc_expr *base_expr;
   gfc_ref *ref, *class_ref, *tail = NULL, *array_ref;
@@ -396,27 +401,59 @@ gfc_find_and_cut_at_last_class_ref (gfc_expr *e, bool is_mold)
   /* Find the last class reference.  */
   class_ref = NULL;
   array_ref = NULL;
-  for (ref = e->ref; ref; ref = ref->next)
+
+  if (ts)
     {
-      if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
-	array_ref = ref;
+      if (e->symtree
+	  && e->symtree->n.sym->ts.type == BT_CLASS)
+	*ts = &e->symtree->n.sym->ts;
+      else
+	*ts = NULL;
+    }
 
-      if (ref->type == REF_COMPONENT
-	  && ref->u.c.component->ts.type == BT_CLASS)
+  for (ref = e->ref; ref; ref = ref->next)
+    {
+      if (ts)
 	{
-	  /* Component to the right of a part reference with nonzero rank
-	     must not have the ALLOCATABLE attribute.  If attempts are
-	     made to reference such a component reference, an error results
-	     followed by an ICE.  */
-	  if (array_ref && CLASS_DATA (ref->u.c.component)->attr.allocatable)
-	    return NULL;
-	  class_ref = ref;
+	  if (ref->type == REF_COMPONENT
+	      && ref->u.c.component->ts.type == BT_CLASS
+	      && ref->next && ref->next->type == REF_COMPONENT
+	      && !strcmp (ref->next->u.c.component->name, "_data")
+	      && ref->next->next
+	      && ref->next->next->type == REF_ARRAY
+	      && ref->next->next->u.ar.type != AR_ELEMENT)
+	    {
+	      *ts = &ref->u.c.component->ts;
+	      class_ref = ref;
+	      break;
+	    }
+
+	  if (ref->next == NULL)
+	    break;
 	}
+      else
+	{
+	  if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
+	    array_ref = ref;
 
-      if (ref->next == NULL)
-	break;
+	  if (ref->type == REF_COMPONENT
+	      && ref->u.c.component->ts.type == BT_CLASS)
+	    {
+	      /* Component to the right of a part reference with nonzero
+		 rank must not have the ALLOCATABLE attribute.  If attempts
+		 are made to reference such a component reference, an error
+		 results followed by an ICE.  */
+	      if (array_ref
+		  && CLASS_DATA (ref->u.c.component)->attr.allocatable)
+		return NULL;
+	      class_ref = ref;
+	    }
+	}
     }
 
+  if (ts && *ts == NULL)
+    return NULL;
+
   /* Remove and store all subsequent references after the
      CLASS reference.  */
   if (class_ref)
@@ -10005,17 +10042,20 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, gfc_typespec ts,
       gfc_add_modify (&block, lse->expr, tmp);
     }
   /* If possible use the rhs vptr copy with trans_scalar_class_assign....  */
-  else if (ts.type == BT_CLASS
-	   && !trans_scalar_class_assign (&block, lse, rse))
+  else if (ts.type == BT_CLASS)
     {
       gfc_add_block_to_block (&block, &lse->pre);
       gfc_add_block_to_block (&block, &rse->pre);
-      /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
-	 for the lhs which ensures that class data rhs cast as a string assigns
-	 correctly.  */
-      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
-			     TREE_TYPE (rse->expr), lse->expr);
-      gfc_add_modify (&block, tmp, rse->expr);
+
+      if (!trans_scalar_class_assign (&block, lse, rse))
+	{
+	  /* ...otherwise assignment suffices. Note the use of VIEW_CONVERT_EXPR
+	  for the lhs which ensures that class data rhs cast as a string assigns
+	  correctly.  */
+	  tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
+				 TREE_TYPE (rse->expr), lse->expr);
+	  gfc_add_modify (&block, tmp, rse->expr);
+	}
     }
   else if (ts.type != BT_CLASS)
     {
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ab53fc5..9e8e861 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -422,6 +422,9 @@ get_array_span (tree type, tree decl)
 		return NULL_TREE;
 	    }
 	  span = gfc_class_vtab_size_get (decl);
+	  /* For unlimited polymorphic entities then _len component needs
+	     to be multiplied with the size.  */
+	  span = gfc_resize_class_size_with_len (NULL, decl, span);
 	}
       else if (GFC_DECL_PTR_ARRAY_P (decl))
 	{
@@ -439,13 +442,31 @@ get_array_span (tree type, tree decl)
 }
 
 
+tree
+gfc_build_spanned_array_ref (tree base, tree offset, tree span)
+{
+  tree type;
+  tree tmp;
+  type = TREE_TYPE (TREE_TYPE (base));
+  offset = fold_build2_loc (input_location, MULT_EXPR,
+			    gfc_array_index_type,
+			    offset, span);
+  tmp = gfc_build_addr_expr (pvoid_type_node, base);
+  tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
+  tmp = fold_convert (build_pointer_type (type), tmp);
+  if ((TREE_CODE (type) != INTEGER_TYPE && TREE_CODE (type) != ARRAY_TYPE)
+      || !TYPE_STRING_FLAG (type))
+    tmp = build_fold_indirect_ref_loc (input_location, tmp);
+  return tmp;
+}
+
+
 /* Build an ARRAY_REF with its natural type.  */
 
 tree
 gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
 {
   tree type = TREE_TYPE (base);
-  tree tmp;
   tree span = NULL_TREE;
 
   if (GFC_ARRAY_TYPE_P (type) && GFC_TYPE_ARRAY_RANK (type) == 0)
@@ -488,18 +509,7 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
   /* If a non-null span has been generated reference the element with
      pointer arithmetic.  */
   if (span != NULL_TREE)
-    {
-      offset = fold_build2_loc (input_location, MULT_EXPR,
-				gfc_array_index_type,
-				offset, span);
-      tmp = gfc_build_addr_expr (pvoid_type_node, base);
-      tmp = fold_build_pointer_plus_loc (input_location, tmp, offset);
-      tmp = fold_convert (build_pointer_type (type), tmp);
-      if ((TREE_CODE (type) != INTEGER_TYPE && TREE_CODE (type) != ARRAY_TYPE)
-	  || !TYPE_STRING_FLAG (type))
-	tmp = build_fold_indirect_ref_loc (input_location, tmp);
-      return tmp;
-    }
+    return gfc_build_spanned_array_ref (base, offset, span);
   /* Otherwise use a straightforward array reference.  */
   else
     return build4_loc (input_location, ARRAY_REF, type, base, offset,
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 44cbfb6..8c6f82f 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -424,7 +424,8 @@ tree gfc_class_vptr_get (tree);
 tree gfc_class_len_get (tree);
 tree gfc_class_len_or_zero_get (tree);
 tree gfc_resize_class_size_with_len (stmtblock_t *, tree, tree);
-gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false);
+gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false,
+					       gfc_typespec **ts = NULL);
 /* Get an accessor to the class' vtab's * field, when a class handle is
    available.  */
 tree gfc_class_vtab_hash_get (tree);
@@ -622,6 +623,9 @@ tree gfc_build_addr_expr (tree, tree);
 /* Build an ARRAY_REF.  */
 tree gfc_build_array_ref (tree, tree, tree, tree vptr = NULL_TREE);
 
+/* Build an array ref using pointer arithmetic.  */
+tree gfc_build_spanned_array_ref (tree base, tree offset, tree span);
+
 /* Creates a label.  Decl is artificial if label_id == NULL_TREE.  */
 tree gfc_build_label_decl (tree);
 
-- 
cgit v1.1


From ee351f7fdbd82f8947fe9a0e74cea65d216a8549 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 16 Apr 2021 00:16:23 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1f8578c..bbf70a6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,32 @@
+2021-04-15  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/99307
+	* symbol.c: Remove trailing white space.
+	* trans-array.c (gfc_trans_create_temp_array): Create a class
+	temporary for class expressions and assign the new descriptor
+	to the data field.
+	(build_class_array_ref): If the class expr can be extracted,
+	then use that for 'decl'. Class function results are reliably
+	handled this way. Call gfc_find_and_cut_at_last_class_ref to
+	eliminate largely redundant code. Remove dead code and recast
+	the rest of the code to extract 'decl' for remaining cases.
+	Call gfc_build_spanned_array_ref.
+	(gfc_alloc_allocatable_for_assignment): Use class descriptor
+	element length for 'elemsize1'. Eliminate repeat set of dtype
+	for class expressions.
+	* trans-expr.c (gfc_find_and_cut_at_last_class_ref): Include
+	additional code from build_class_array_ref, and use optional
+	gfc_typespec pointer argument.
+	(gfc_trans_scalar_assign): Make use of pre and post blocks for
+	all class expressions.
+	* trans.c (get_array_span): For unlimited polymorphic exprs
+	multiply the span by the value of the _len field.
+	(gfc_build_spanned_array_ref): New function.
+	(gfc_build_array_ref): Call gfc_build_spanned_array_ref and
+	eliminate repeated code.
+	* trans.h: Add arg to gfc_find_and_cut_at_last_class_ref and
+	add prototype for gfc_build_spanned_array_ref.
+
 2021-04-14  Martin Liska  <mliska@suse.cz>
 
 	* intrinsic.texi: The table has first column empty and it makes
-- 
cgit v1.1


From d264194c1069fbcd129222f86455137f29a5c6fd Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 16 Apr 2021 16:24:31 +0200
Subject: PR fortran/63797 - Bogus ambiguous reference to 'sqrt'

The interface of an intrinsic procedure is automatically explicit.
Do not write it to the module file to prevent wrong ambiguities on USE.

gcc/fortran/ChangeLog:

	PR fortran/63797
	* module.c (write_symtree): Do not write interface of intrinsic
	procedure to module file for F2003 and newer.

gcc/testsuite/ChangeLog:

	PR fortran/63797
	* gfortran.dg/pr63797.f90: New test.

Co-authored-by: Paul Thomas <pault@gcc.gnu.org>
---
 gcc/fortran/module.c | 11 +++++++++++
 1 file changed, 11 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 4db0a3a..089453c 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -6218,6 +6218,17 @@ write_symtree (gfc_symtree *st)
   if (check_unique_name (st->name))
     return;
 
+  /* From F2003 onwards, intrinsic procedures are no longer subject to
+     the restriction, "that an elemental intrinsic function here be of
+     type integer or character and each argument must be an initialization
+     expr of type integer or character" is lifted so that intrinsic
+     procedures can be over-ridden. This requires that the intrinsic
+     symbol not appear in the module file, thereby preventing ambiguity
+     when USEd.  */
+  if (strcmp (sym->module, "(intrinsic)") == 0
+      && (gfc_option.allow_std & GFC_STD_F2003))
+    return;
+
   p = find_pointer (sym);
   if (p == NULL)
     gfc_internal_error ("write_symtree(): Symbol not written");
-- 
cgit v1.1


From 98c5b5924de969ae8ab37d140aa85bcca3f3c76c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 <jrfsousa@gmail.com>
Date: Fri, 16 Apr 2021 16:17:21 +0000
Subject: Fortran: Fix ICE due to referencing a NULL pointer [PR100018]

gcc/fortran/ChangeLog:

	PR fortran/100018
	* resolve.c: Add association check before de-referencing pointer.

gcc/testsuite/ChangeLog:

	PR fortran/100018
	* gfortran.dg/PR10018.f90: New test.
---
 gcc/fortran/resolve.c | 1 +
 1 file changed, 1 insertion(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 1c9b0c5..dd4b266 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11999,6 +11999,7 @@ start:
 	    /* Assigning a class object always is a regular assign.  */
 	    if (code->expr2->ts.type == BT_CLASS
 		&& code->expr1->ts.type == BT_CLASS
+		&& CLASS_DATA (code->expr2)
 		&& !CLASS_DATA (code->expr2)->attr.dimension
 		&& !(gfc_expr_attr (code->expr1).proc_pointer
 		     && code->expr2->expr_type == EXPR_VARIABLE
-- 
cgit v1.1


From c1c86ab96c20a3f52fb59e0532ae9c93665deb44 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 <jrfsousa@gmail.com>
Date: Fri, 16 Apr 2021 23:33:04 +0000
Subject: Fortran: Add missing TKR initialization [PR100094]

gcc/fortran/ChangeLog:

	PR fortran/100094
	* trans-array.c (gfc_trans_deferred_array): Add code to initialize
	pointers and allocatables with correct TKR parameters.

gcc/testsuite/ChangeLog:

	PR fortran/100094
	* gfortran.dg/PR100094.f90: New test.
---
 gcc/fortran/trans-array.c | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index ca90142..e99980f 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -10874,6 +10874,20 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
 	}
     }
 
+  /* Set initial TKR for pointers and allocatables */
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && (sym->attr.pointer || sym->attr.allocatable))
+    {
+      tree etype;
+
+      gcc_assert (sym->as && sym->as->rank>=0);
+      tmp = gfc_conv_descriptor_dtype (descriptor);
+      etype = gfc_get_element_type (type);
+      tmp = fold_build2_loc (input_location, MODIFY_EXPR,
+  			     TREE_TYPE (tmp), tmp,
+  			     gfc_get_dtype_rank_type (sym->as->rank, etype));
+      gfc_add_expr_to_block (&init, tmp);
+    }
   gfc_restore_backend_locus (&loc);
   gfc_init_block (&cleanup);
 
-- 
cgit v1.1


From 8ae884c09fbba91e9cec391290ee4a2859e7ff41 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 17 Apr 2021 00:16:25 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bbf70a6..86ef778 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2021-04-16  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
+
+	PR fortran/100094
+	* trans-array.c (gfc_trans_deferred_array): Add code to initialize
+	pointers and allocatables with correct TKR parameters.
+
+2021-04-16  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
+
+	PR fortran/100018
+	* resolve.c: Add association check before de-referencing pointer.
+
+2021-04-16  Harald Anlauf  <anlauf@gmx.de>
+	    Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/63797
+	* module.c (write_symtree): Do not write interface of intrinsic
+	procedure to module file for F2003 and newer.
+
 2021-04-15  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/99307
-- 
cgit v1.1


From 3395dfc4da8ad1fccd346c62dfc9bd44b2b48c62 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Mon, 19 Apr 2021 10:24:49 +0200
Subject: [OpenACC 'kernels'] '-fopenacc-kernels=[...]' ->
 '--param=openacc-kernels=[...]'

This configuration knob is temporary, and isn't really meant to be exposed to
users.

	gcc/
	* params.opt (-param=openacc-kernels=): Add.
	* omp-oacc-kernels-decompose.cc
	(pass_omp_oacc_kernels_decompose::gate): Use it.
	* doc/invoke.texi (-fopenacc-kernels=@var{mode}): Move...
	(--param): ... here, 'openacc-kernels'.
	gcc/c-family/
	* c.opt (fopenacc-kernels=): Remove.
	gcc/fortran/
	* lang.opt (fopenacc-kernels=): Remove.
	gcc/testsuite/
	* c-c++-common/goacc/if-clause-2.c: '-fopenacc-kernels=[...]' ->
	'--param=openacc-kernels=[...]'.
	* c-c++-common/goacc/kernels-decompose-1.c: Likewise.
	* c-c++-common/goacc/kernels-decompose-2.c: Likewise.
	* c-c++-common/goacc/kernels-decompose-ice-1.c: Likewise.
	* c-c++-common/goacc/kernels-decompose-ice-2.c: Likewise.
	* gfortran.dg/goacc/kernels-decompose-1.f95: Likewise.
	* gfortran.dg/goacc/kernels-decompose-2.f95: Likewise.
	* gfortran.dg/goacc/kernels-tree.f95: Likewise.
	libgomp/
	* testsuite/libgomp.oacc-c-c++-common/declare-vla-kernels-decompose-ice-1.c:
	'-fopenacc-kernels=[...]' -> '--param=openacc-kernels=[...]'.
	* testsuite/libgomp.oacc-c-c++-common/declare-vla-kernels-decompose.c:
	Likewise.
	* testsuite/libgomp.oacc-c-c++-common/kernels-decompose-1.c:
	Likewise.
	* testsuite/libgomp.oacc-fortran/pr94358-1.f90: Likewise.
---
 gcc/fortran/lang.opt | 4 ----
 1 file changed, 4 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 2b1977c..388ef8c 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -691,10 +691,6 @@ fopenacc-dim=
 Fortran LTO Joined Var(flag_openacc_dims)
 ; Documented in C
 
-fopenacc-kernels=
-Fortran RejectNegative Joined Enum(openacc_kernels) Var(flag_openacc_kernels) Init(OPENACC_KERNELS_PARLOOPS)
-; Documented in C
-
 fopenmp
 Fortran LTO
 ; Documented in C
-- 
cgit v1.1


From 6e81e015d91568fc3df3939623ae999e0681a0fc Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 20 Apr 2021 00:16:27 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 4 ++++
 1 file changed, 4 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 86ef778..2e61504 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,7 @@
+2021-04-19  Thomas Schwinge  <thomas@codesourcery.com>
+
+	* lang.opt (fopenacc-kernels=): Remove.
+
 2021-04-16  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
 
 	PR fortran/100094
-- 
cgit v1.1


From 67378cd63d62bf0c69e966d1d202a1e586550a68 Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Tue, 20 Apr 2021 07:30:07 +0100
Subject: Fortran: Fix host associated PDT entity initialization [PR99307].

2021-04-20  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/100110
	* trans-decl.c (gfc_get_symbol_decl): Replace test for host
	association with a check that the current and symbol namespaces
	are the same.

gcc/testsuite/
	PR fortran/100110
	* gfortran.dg/pdt_31.f03: New test.
	* gfortran.dg/pdt_26.f03: Reduce 'builtin_malloc' count from 9
	to 8.
---
 gcc/fortran/trans-decl.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 34a0d49..cc9d855 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1548,7 +1548,8 @@ gfc_get_symbol_decl (gfc_symbol * sym)
      declaration of the entity and memory allocated/deallocated.  */
   if ((sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
       && sym->param_list != NULL
-      && !(sym->attr.host_assoc || sym->attr.use_assoc || sym->attr.dummy))
+      && gfc_current_ns == sym->ns
+      && !(sym->attr.use_assoc || sym->attr.dummy))
     gfc_defer_symbol_init (sym);
 
   /* Dummy PDT 'len' parameters should be checked when they are explicit.  */
-- 
cgit v1.1


From be8aad8d73f47e2581c873ba1069489e071c2a86 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 21 Apr 2021 00:16:23 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2e61504..1780397 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-04-20  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/100110
+	* trans-decl.c (gfc_get_symbol_decl): Replace test for host
+	association with a check that the current and symbol namespaces
+	are the same.
+
 2021-04-19  Thomas Schwinge  <thomas@codesourcery.com>
 
 	* lang.opt (fopenacc-kernels=): Remove.
-- 
cgit v1.1


From a61c4964cd71446232d62ec9b10a7d45b440dd9f Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Wed, 21 Apr 2021 10:58:29 +0200
Subject: Fortran/OpenMP: Add 'omp depobj' and 'depend(mutexinoutset:'

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset
	in the depend clause.
	(show_omp_clauses, show_omp_node, show_code_node): Handle depobj.
	* gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ.
	(enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET,
	OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ.
	(gfc_omp_clauses): Add destroy, depobj_update and depobj.
	(enum gfc_exec_op): Add EXEC_OMP_DEPOBJ
	* match.h (gfc_match_omp_depobj): Match 'omp depobj'.
	* openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset
	to depend clause.
	(gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive):
	Handle 'omp depobj'.
	* parse.c (decode_omp_directive, next_statement, gfc_ascii_statement):
	Likewise.
	* resolve.c (gfc_resolve_code): Likewise.
	* st.c (gfc_free_statement): Likewise.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset
	in the depend clause.
	(gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ.
	* trans.c (trans_code): Likewise.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/depobj-1.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/depobj-1.f90: New test.
	* gfortran.dg/gomp/depobj-2.f90: New test.
---
 gcc/fortran/dump-parse-tree.c |  33 ++++++++++++
 gcc/fortran/gfortran.h        |  12 +++--
 gcc/fortran/match.h           |   1 +
 gcc/fortran/openmp.c          | 113 ++++++++++++++++++++++++++++++++++++++++++
 gcc/fortran/parse.c           |   6 ++-
 gcc/fortran/resolve.c         |   1 +
 gcc/fortran/st.c              |   1 +
 gcc/fortran/trans-openmp.c    |  68 +++++++++++++++++++++++++
 gcc/fortran/trans.c           |   1 +
 9 files changed, 231 insertions(+), 5 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 059d842..b50265a 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1332,6 +1332,10 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
 	  case OMP_DEPEND_IN: fputs ("in:", dumpfile); break;
 	  case OMP_DEPEND_OUT: fputs ("out:", dumpfile); break;
 	  case OMP_DEPEND_INOUT: fputs ("inout:", dumpfile); break;
+	  case OMP_DEPEND_DEPOBJ: fputs ("depobj:", dumpfile); break;
+	  case OMP_DEPEND_MUTEXINOUTSET:
+	    fputs ("mutexinoutset:", dumpfile);
+	    break;
 	  case OMP_DEPEND_SINK_FIRST:
 	    fputs ("sink:", dumpfile);
 	    while (1)
@@ -1754,10 +1758,27 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       show_expr (omp_clauses->if_exprs[i]);
       fputc (')', dumpfile);
     }
+  if (omp_clauses->destroy)
+    fputs (" DESTROY", dumpfile);
   if (omp_clauses->depend_source)
     fputs (" DEPEND(source)", dumpfile);
   if (omp_clauses->capture)
     fputs (" CAPTURE", dumpfile);
+  if (omp_clauses->depobj_update != OMP_DEPEND_UNSET)
+    {
+      const char *deptype;
+      fputs (" UPDATE(", dumpfile);
+      switch (omp_clauses->depobj_update)
+	{
+	case OMP_DEPEND_IN: deptype = "IN"; break;
+	case OMP_DEPEND_OUT: deptype = "OUT"; break;
+	case OMP_DEPEND_INOUT: deptype = "INOUT"; break;
+	case OMP_DEPEND_MUTEXINOUTSET: deptype = "MUTEXINOUTSET"; break;
+	default: gcc_unreachable ();
+	}
+      fputs (deptype, dumpfile);
+      fputc (')', dumpfile);
+    }
   if (omp_clauses->atomic_op != GFC_OMP_ATOMIC_UNSET)
     {
       const char *atomic_op;
@@ -1831,6 +1852,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
     case EXEC_OMP_MASTER: name = "MASTER"; break;
     case EXEC_OMP_ORDERED: name = "ORDERED"; break;
+    case EXEC_OMP_DEPOBJ: name = "DEPOBJ"; break;
     case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
     case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
     case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
@@ -1941,6 +1963,15 @@ show_omp_node (int level, gfc_code *c)
       if (omp_clauses)
 	fprintf (dumpfile, " (%s)", c->ext.omp_clauses->critical_name);
       break;
+    case EXEC_OMP_DEPOBJ:
+      omp_clauses = c->ext.omp_clauses;
+      if (omp_clauses)
+	{
+	  fputc ('(', dumpfile);
+	  show_expr (c->ext.omp_clauses->depobj);
+	  fputc (')', dumpfile);
+	}
+      break;
     case EXEC_OMP_FLUSH:
       if (c->ext.omp_namelist)
 	{
@@ -1969,6 +2000,7 @@ show_omp_node (int level, gfc_code *c)
       || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
       || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
       || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
+      || c->op == EXEC_OMP_DEPOBJ
       || (c->op == EXEC_OMP_ORDERED && c->block == NULL))
     return;
   if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -3094,6 +3126,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_CANCELLATION_POINT:
     case EXEC_OMP_BARRIER:
     case EXEC_OMP_CRITICAL:
+    case EXEC_OMP_DEPOBJ:
     case EXEC_OMP_DISTRIBUTE:
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7935aca..d12be0c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -261,7 +261,7 @@ enum gfc_statement
   ST_OMP_TARGET_PARALLEL_DO_SIMD, ST_OMP_END_TARGET_PARALLEL_DO_SIMD,
   ST_OMP_TARGET_ENTER_DATA, ST_OMP_TARGET_EXIT_DATA,
   ST_OMP_TARGET_SIMD, ST_OMP_END_TARGET_SIMD,
-  ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN,
+  ST_OMP_TASKLOOP, ST_OMP_END_TASKLOOP, ST_OMP_SCAN, ST_OMP_DEPOBJ,
   ST_OMP_TASKLOOP_SIMD, ST_OMP_END_TASKLOOP_SIMD, ST_OMP_ORDERED_DEPEND,
   ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
   ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
@@ -1198,9 +1198,12 @@ enum gfc_omp_reduction_op
 
 enum gfc_omp_depend_op
 {
+  OMP_DEPEND_UNSET,
   OMP_DEPEND_IN,
   OMP_DEPEND_OUT,
   OMP_DEPEND_INOUT,
+  OMP_DEPEND_MUTEXINOUTSET,
+  OMP_DEPEND_DEPOBJ,
   OMP_DEPEND_SINK_FIRST,
   OMP_DEPEND_SINK
 };
@@ -1402,11 +1405,12 @@ typedef struct gfc_omp_clauses
   bool nowait, ordered, untied, mergeable;
   bool inbranch, notinbranch, defaultmap, nogroup;
   bool sched_simd, sched_monotonic, sched_nonmonotonic;
-  bool simd, threads, depend_source, order_concurrent, capture;
+  bool simd, threads, depend_source, destroy, order_concurrent, capture;
   enum gfc_omp_atomic_op atomic_op;
   enum gfc_omp_memorder memorder;
   enum gfc_omp_cancel_kind cancel;
   enum gfc_omp_proc_bind_kind proc_bind;
+  enum gfc_omp_depend_op depobj_update;
   struct gfc_expr *safelen_expr;
   struct gfc_expr *simdlen_expr;
   struct gfc_expr *num_teams;
@@ -1417,6 +1421,7 @@ typedef struct gfc_omp_clauses
   struct gfc_expr *num_tasks;
   struct gfc_expr *priority;
   struct gfc_expr *detach;
+  struct gfc_expr *depobj;
   struct gfc_expr *if_exprs[OMP_IF_LAST];
   enum gfc_omp_sched_kind dist_sched_kind;
   struct gfc_expr *dist_chunk_size;
@@ -1437,7 +1442,6 @@ typedef struct gfc_omp_clauses
   unsigned par_auto:1, gang_static:1;
   unsigned if_present:1, finalize:1;
   locus loc;
-
 }
 gfc_omp_clauses;
 
@@ -2700,7 +2704,7 @@ enum gfc_exec_op
   EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA,
   EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO,
   EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD,
-  EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN
+  EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ
 };
 
 typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 20a530f..b72ec67 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -160,6 +160,7 @@ match gfc_match_omp_critical (void);
 match gfc_match_omp_declare_reduction (void);
 match gfc_match_omp_declare_simd (void);
 match gfc_match_omp_declare_target (void);
+match gfc_match_omp_depobj (void);
 match gfc_match_omp_distribute (void);
 match gfc_match_omp_distribute_parallel_do (void);
 match gfc_match_omp_distribute_parallel_do_simd (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1f1920c..a1b0572 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1381,6 +1381,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		depend_op = OMP_DEPEND_IN;
 	      else if (gfc_match ("out") == MATCH_YES)
 		depend_op = OMP_DEPEND_OUT;
+	      else if (gfc_match ("mutexinoutset") == MATCH_YES)
+		depend_op = OMP_DEPEND_MUTEXINOUTSET;
+	      else if (gfc_match ("depobj") == MATCH_YES)
+		depend_op = OMP_DEPEND_DEPOBJ;
 	      else if (!c->depend_source
 		       && gfc_match ("source )") == MATCH_YES)
 		{
@@ -2898,6 +2902,86 @@ gfc_match_omp_end_critical (void)
   return MATCH_YES;
 }
 
+/* depobj(depobj) depend(dep-type:loc)|destroy|update(dep-type)
+   dep-type = in/out/inout/mutexinoutset/depobj/source/sink
+   depend: !source, !sink
+   update: !source, !sink, !depobj
+   locator = exactly one list item  .*/
+match
+gfc_match_omp_depobj (void)
+{
+  gfc_omp_clauses *c = NULL;
+  gfc_expr *depobj;
+
+  if (gfc_match (" ( %v ) ", &depobj) != MATCH_YES)
+    {
+      gfc_error ("Expected %<( depobj )%> at %C");
+      return MATCH_ERROR;
+    }
+  if (gfc_match ("update ( ") == MATCH_YES)
+    {
+      c = gfc_get_omp_clauses ();
+      if (gfc_match ("inout )") == MATCH_YES)
+	c->depobj_update = OMP_DEPEND_INOUT;
+      else if (gfc_match ("in )") == MATCH_YES)
+	c->depobj_update = OMP_DEPEND_IN;
+      else if (gfc_match ("out )") == MATCH_YES)
+	c->depobj_update = OMP_DEPEND_OUT;
+      else if (gfc_match ("mutexinoutset )") == MATCH_YES)
+	c->depobj_update = OMP_DEPEND_MUTEXINOUTSET;
+      else
+	{
+	  gfc_error ("Expected IN, OUT, INOUT, MUTEXINOUTSET followed by "
+		     "%<)%> at %C");
+	  goto error;
+	}
+    }
+  else if (gfc_match ("destroy") == MATCH_YES)
+    {
+      c = gfc_get_omp_clauses ();
+      c->destroy = true;
+    }
+  else if (gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_DEPEND), true, false)
+	   != MATCH_YES)
+    goto error;
+
+  if (c->depobj_update == OMP_DEPEND_UNSET && !c->destroy)
+    {
+      if (!c->depend_source && !c->lists[OMP_LIST_DEPEND])
+	{
+	  gfc_error ("Expected DEPEND, UPDATE, or DESTROY clause at %C");
+	  goto error;
+	}
+      if (c->depend_source
+	  || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK_FIRST
+	  || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_SINK
+	  || c->lists[OMP_LIST_DEPEND]->u.depend_op == OMP_DEPEND_DEPOBJ)
+	{
+	  gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall not "
+		     "have dependence-type SOURCE, SINK or DEPOBJ",
+		     c->lists[OMP_LIST_DEPEND]
+		     ? &c->lists[OMP_LIST_DEPEND]->where : &gfc_current_locus);
+	  goto error;
+	}
+      if (c->lists[OMP_LIST_DEPEND]->next)
+	{
+	  gfc_error ("DEPEND clause at %L of OMP DEPOBJ construct shall have "
+		     "only a single locator",
+		     &c->lists[OMP_LIST_DEPEND]->next->where);
+	  goto error;
+	}
+    }
+
+  c->depobj = depobj;
+  new_st.op = EXEC_OMP_DEPOBJ;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+
+error:
+  gfc_free_expr (depobj);
+  gfc_free_omp_clauses (c);
+  return MATCH_ERROR;
+}
 
 match
 gfc_match_omp_distribute (void)
@@ -4877,6 +4961,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		   "clause at %L", &code->loc);
     }
 
+  if (omp_clauses->depobj
+      && (!gfc_resolve_expr (omp_clauses->depobj)
+	  || omp_clauses->depobj->ts.type != BT_INTEGER
+	  || omp_clauses->depobj->ts.kind != 2 * gfc_index_integer_kind
+	  || omp_clauses->depobj->rank != 0))
+    gfc_error ("DEPOBJ in DEPOBJ construct at %L shall be a scalar integer "
+	       "of OMP_DEPEND_KIND kind", &omp_clauses->depobj->where);
+
   /* Check that no symbol appears on multiple clauses, except that
      a symbol can appear on both firstprivate and lastprivate.  */
   for (list = 0; list < OMP_LIST_NUM; list++)
@@ -5173,6 +5265,26 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		      gfc_error ("Only SOURCE or SINK dependence types "
 				 "are allowed on ORDERED directive at %L",
 				 &n->where);
+		    else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+			     && !n->expr
+			     && (n->sym->ts.type != BT_INTEGER
+				 || n->sym->ts.kind
+				    != 2 * gfc_index_integer_kind
+				 || n->sym->attr.dimension))
+		      gfc_error ("Locator %qs at %L in DEPEND clause of depobj "
+				 "type shall be a scalar integer of "
+				 "OMP_DEPEND_KIND kind", n->sym->name,
+				 &n->where);
+		    else if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+			     && n->expr
+			     && (!gfc_resolve_expr (n->expr)
+				 || n->expr->ts.type != BT_INTEGER
+				 || n->expr->ts.kind
+				    != 2 * gfc_index_integer_kind
+				 || n->expr->rank != 0))
+		      gfc_error ("Locator at %L in DEPEND clause of depobj "
+				 "type shall be a scalar integer of "
+				 "OMP_DEPEND_KIND kind", &n->expr->where);
 		  }
 		gfc_ref *lastref = NULL, *lastslice = NULL;
 		bool resolved = false;
@@ -7211,6 +7323,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_TASK:
     case EXEC_OMP_TEAMS:
     case EXEC_OMP_WORKSHARE:
+    case EXEC_OMP_DEPOBJ:
       if (code->ext.omp_clauses)
 	resolve_omp_clauses (code, code->ext.omp_clauses, NULL);
       break;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1549f8e..9bbe9e8 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -895,6 +895,7 @@ decode_omp_directive (void)
     case 'd':
       matchds ("declare reduction", gfc_match_omp_declare_reduction,
 	       ST_OMP_DECLARE_REDUCTION);
+      matcho ("depobj", gfc_match_omp_depobj, ST_OMP_DEPOBJ);
       matchs ("distribute parallel do simd",
 	      gfc_match_omp_distribute_parallel_do_simd,
 	      ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD);
@@ -1588,7 +1589,7 @@ next_statement (void)
   case ST_ASSIGNMENT: case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
   case ST_LABEL_ASSIGNMENT: case ST_FLUSH: case ST_OMP_FLUSH: \
   case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
-  case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: \
+  case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
   case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
   case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
   case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
@@ -2285,6 +2286,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_DECLARE_TARGET:
       p = "!$OMP DECLARE TARGET";
       break;
+    case ST_OMP_DEPOBJ:
+      p = "!$OMP DEPOBJ";
+      break;
     case ST_OMP_DISTRIBUTE:
       p = "!$OMP DISTRIBUTE";
       break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index dd4b266..5a81387 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12198,6 +12198,7 @@ start:
 	case EXEC_OMP_CANCELLATION_POINT:
 	case EXEC_OMP_CRITICAL:
 	case EXEC_OMP_FLUSH:
+	case EXEC_OMP_DEPOBJ:
 	case EXEC_OMP_DISTRIBUTE:
 	case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
 	case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 13b3880..9e76199 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -218,6 +218,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_CANCELLATION_POINT:
     case EXEC_OMP_CRITICAL:
+    case EXEC_OMP_DEPOBJ:
     case EXEC_OMP_DISTRIBUTE:
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 349df1c..bf3f261 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -2545,6 +2545,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		  tree decl = gfc_trans_omp_variable (n->sym, false);
 		  if (gfc_omp_privatize_by_reference (decl))
 		    decl = build_fold_indirect_ref (decl);
+		  if (n->u.depend_op == OMP_DEPEND_DEPOBJ
+		      && POINTER_TYPE_P (TREE_TYPE (decl)))
+		    decl = build_fold_indirect_ref (decl);
 		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
 		    {
 		      decl = gfc_conv_descriptor_data_get (decl);
@@ -2587,6 +2590,13 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		case OMP_DEPEND_INOUT:
 		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
 		  break;
+		case OMP_DEPEND_MUTEXINOUTSET:
+		  OMP_CLAUSE_DEPEND_KIND (node)
+		    = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
+		  break;
+		case OMP_DEPEND_DEPOBJ:
+		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
+		  break;
 		default:
 		  gcc_unreachable ();
 		}
@@ -4913,6 +4923,62 @@ gfc_trans_oacc_combined_directive (gfc_code *code)
 }
 
 static tree
+gfc_trans_omp_depobj (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_se se;
+  gfc_init_se (&se, NULL);
+  gfc_init_block (&block);
+  gfc_conv_expr (&se, code->ext.omp_clauses->depobj);
+  gcc_assert (se.pre.head == NULL && se.post.head == NULL);
+  tree depobj = se.expr;
+  location_t loc = EXPR_LOCATION (depobj);
+  if (!POINTER_TYPE_P (TREE_TYPE (depobj)))
+    depobj = gfc_build_addr_expr (NULL, depobj);
+  depobj = fold_convert (build_pointer_type_for_mode (ptr_type_node,
+						      TYPE_MODE (ptr_type_node),
+						      true), depobj);
+  gfc_omp_namelist *n = code->ext.omp_clauses->lists[OMP_LIST_DEPEND];
+  if (n)
+    {
+      tree var;
+      if (n->expr)
+        var = gfc_convert_expr_to_tree (&block, n->expr);
+      else
+	var = gfc_get_symbol_decl (n->sym);
+      if (!POINTER_TYPE_P (TREE_TYPE (var)))
+        var = gfc_build_addr_expr (NULL, var);
+      depobj = save_expr (depobj);
+      tree r = build_fold_indirect_ref_loc (loc, depobj);
+      gfc_add_expr_to_block (&block,
+			     build2 (MODIFY_EXPR, void_type_node, r, var));
+    }
+
+  /* Only one may be set. */
+  gcc_assert (((int)(n != NULL) + (int)(code->ext.omp_clauses->destroy)
+	      + (int)(code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET))
+	      == 1);
+  int k = -1; /* omp_clauses->destroy */
+  if (!code->ext.omp_clauses->destroy)
+    switch (code->ext.omp_clauses->depobj_update != OMP_DEPEND_UNSET
+	    ? code->ext.omp_clauses->depobj_update : n->u.depend_op)
+      {
+      case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
+      case OMP_DEPEND_OUT: k = GOMP_DEPEND_IN; break;
+      case OMP_DEPEND_INOUT: k = GOMP_DEPEND_IN; break;
+      case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break;
+      default: gcc_unreachable ();
+      }
+  tree t = build_int_cst (ptr_type_node, k);
+  depobj = build2_loc (loc, POINTER_PLUS_EXPR, TREE_TYPE (depobj), depobj,
+                       TYPE_SIZE_UNIT (ptr_type_node));
+  depobj = build_fold_indirect_ref_loc (loc, depobj);
+  gfc_add_expr_to_block (&block, build2 (MODIFY_EXPR, void_type_node, depobj, t));
+
+  return gfc_finish_block (&block);
+}
+
+static tree
 gfc_trans_omp_flush (gfc_code *code)
 {
   tree call;
@@ -6181,6 +6247,8 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_cancellation_point (code);
     case EXEC_OMP_CRITICAL:
       return gfc_trans_omp_critical (code);
+    case EXEC_OMP_DEPOBJ:
+      return gfc_trans_omp_depobj (code);
     case EXEC_OMP_DISTRIBUTE:
     case EXEC_OMP_DO:
     case EXEC_OMP_SIMD:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 9e8e861..624c713 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2161,6 +2161,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_CANCEL:
 	case EXEC_OMP_CANCELLATION_POINT:
 	case EXEC_OMP_CRITICAL:
+	case EXEC_OMP_DEPOBJ:
 	case EXEC_OMP_DISTRIBUTE:
 	case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
 	case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
-- 
cgit v1.1


From c1ef0c9234c29c33397b7687ba54c1221fcbcb6b Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 22 Apr 2021 00:16:32 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1780397..de0de2e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,27 @@
+2021-04-21  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset
+	in the depend clause.
+	(show_omp_clauses, show_omp_node, show_code_node): Handle depobj.
+	* gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ.
+	(enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET,
+	OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ.
+	(gfc_omp_clauses): Add destroy, depobj_update and depobj.
+	(enum gfc_exec_op): Add EXEC_OMP_DEPOBJ
+	* match.h (gfc_match_omp_depobj): Match 'omp depobj'.
+	* openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset
+	to depend clause.
+	(gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive):
+	Handle 'omp depobj'.
+	* parse.c (decode_omp_directive, next_statement, gfc_ascii_statement):
+	Likewise.
+	* resolve.c (gfc_resolve_code): Likewise.
+	* st.c (gfc_free_statement): Likewise.
+	* trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset
+	in the depend clause.
+	(gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ.
+	* trans.c (trans_code): Likewise.
+
 2021-04-20  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/100110
-- 
cgit v1.1


From 3cf04d1afa8a4955a0a9a395dd21ce1b6484aa78 Mon Sep 17 00:00:00 2001
From: Michael Meissner <meissner@linux.ibm.com>
Date: Wed, 21 Apr 2021 23:02:07 -0400
Subject: Fix Fortran rounding issues, PR fortran/96983.

I was looking at Fortran PR 96983, which fails on the PowerPC when trying to
run the test PR96711.F90.  The compiler ICEs because the PowerPC does not have
a floating point type with a type precision of 128.  The reason is that the
PowerPC has 3 different 128 bit floating point types (__float128/_Float128,
__ibm128, and long double).  Currently long double uses the IBM extended double
type, but we would like to switch to using IEEE 128-bit long doubles in the
future.

In order to prevent the compiler from converting explicit __ibm128 types to
long double when long double uses the IEEE 128-bit representation, we have set
up the precision for __ibm128 to be 128, long double to be 127, and
__float128/_Float128 to be 126.

Originally, I was trying to see if for Fortran, I could change the precision of
long double to be 128 (Fortran doesn't access __ibm128), but it quickly became
hard to get the changes to work.

I looked at the Fortran code in build_round_expr, and I came to the conclusion
that there is no reason to promote the floating point type.  If you just do a
normal round of the value using the current floating point format and then
convert it to the integer type.  We don't have an appropriate built-in function
that provides the equivalent of llround for 128-bit integer types.

This patch fixes the compiler crash.

However, while with this patch, the PowerPC compiler will not crash when
building the test case, it will not run on the current default installation.
The failure is because the test is explicitly expecting 128-bit floating point
to handle 10384593717069655257060992658440192_16 (i.e. 2**113).

By default, the PowerPC uses IBM extended double used for 128-bit floating
point.  The IBM extended double format is a pair of doubles that provides more
mantissa bits but does not grow the expoenent range.  The value in the test is
fine for IEEE 128-bit floating point, but it is too large for the PowerPC
extended double setup.

I have built the following tests with this patch:

   * I have built a bootstrap compiler on a little endian power9 Linux system
     with the default long double format (IBM extended double).  The
     pr96711.f90 test builds, but it does not run due to the range of the
     real*16 exponent.  There were no other regressions in the C/C++/Fortran
     tests.

   * I have built a bootstrap compiler on a little endian power9 Linux system
     with the default long double format set to IEEE 128-bit. I used the
     Advance Toolchain 14.0-2 to provide the IEEE 128-bits.  The compiler was
     configured to build power9 code by default, so the test generated native
     power9 IEEE 128-bit instructions.  The pr96711.f90 test builds and runs
     correctly in this setup.

   * I have built a bootstrap compiler on a big endian power8 Linux system with
     the default long double format (IBM extended double).  Like the first
     case, the pr96711.f90 test does not crash the compiler, but the test fails
     due to the range of the real*16 exponent.    There were no other
     regressions in the C/C++/Fortran tests.

   * I built a bootstrap compiler on my x86_64 laptop.  There were no
     regressions in the tests.

gcc/fortran/
2021-04-21  Michael Meissner  <meissner@linux.ibm.com>

	PR fortran/96983
	* trans-intrinsic.c (build_round_expr): If int type is larger than
	long long, do the round and convert to the integer type.  Do not
	try to find a floating point type the exact size of the integer
	type.
---
 gcc/fortran/trans-intrinsic.c | 26 ++++++++------------------
 1 file changed, 8 insertions(+), 18 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5e53d11..cceef8f 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -386,30 +386,20 @@ build_round_expr (tree arg, tree restype)
   argprec = TYPE_PRECISION (argtype);
   resprec = TYPE_PRECISION (restype);
 
-  /* Depending on the type of the result, choose the int intrinsic
-     (iround, available only as a builtin, therefore cannot use it for
-     __float128), long int intrinsic (lround family) or long long
-     intrinsic (llround).  We might also need to convert the result
-     afterwards.  */
+  /* Depending on the type of the result, choose the int intrinsic (iround,
+     available only as a builtin, therefore cannot use it for __float128), long
+     int intrinsic (lround family) or long long intrinsic (llround).  If we
+     don't have an appropriate function that converts directly to the integer
+     type (such as kind == 16), just use ROUND, and then convert the result to
+     an integer.  We might also need to convert the result afterwards.  */
   if (resprec <= INT_TYPE_SIZE && argprec <= LONG_DOUBLE_TYPE_SIZE)
     fn = builtin_decl_for_precision (BUILT_IN_IROUND, argprec);
   else if (resprec <= LONG_TYPE_SIZE)
     fn = builtin_decl_for_precision (BUILT_IN_LROUND, argprec);
   else if (resprec <= LONG_LONG_TYPE_SIZE)
     fn = builtin_decl_for_precision (BUILT_IN_LLROUND, argprec);
-  else if (resprec >= argprec && resprec == 128)
-    {
-      /* Search for a real kind suitable as temporary for conversion.  */
-      int kind = -1;
-      for (int i = 0; kind < 0 && gfc_real_kinds[i].kind != 0; i++)
-	if (gfc_real_kinds[i].mode_precision >= resprec)
-	  kind = gfc_real_kinds[i].kind;
-      if (kind < 0)
-	gfc_internal_error ("Could not find real kind with at least %d bits",
-			    resprec);
-      arg = fold_convert (gfc_get_real_type (kind), arg);
-      fn = gfc_builtin_decl_for_float_kind (BUILT_IN_ROUND, kind);
-    }
+  else if (resprec >= argprec)
+    fn = builtin_decl_for_precision (BUILT_IN_ROUND, argprec);
   else
     gcc_unreachable ();
 
-- 
cgit v1.1


From 3bb6a9c01f1e9b5daf9b37fca57e90804ba90d66 Mon Sep 17 00:00:00 2001
From: Martin Liska <mliska@suse.cz>
Date: Thu, 22 Apr 2021 11:32:29 +0200
Subject: Fix various typos.

	PR testsuite/100159
	PR testsuite/100192

gcc/ChangeLog:

	* builtins.c (expand_builtin): Fix typos and missing comments.
	* dwarf2out.c (gen_subprogram_die): Likewise.
	(gen_struct_or_union_type_die): Likewise.

gcc/fortran/ChangeLog:

	* frontend-passes.c (optimize_expr): Fix typos and missing comments.

gcc/testsuite/ChangeLog:

	* g++.dg/template/nontype29.C: Fix typos and missing comments.
	* gcc.dg/Warray-bounds-64.c: Likewise.
	* gcc.dg/Warray-parameter.c: Likewise.
	* gcc.dg/Wstring-compare.c: Likewise.
	* gcc.dg/format/gcc_diag-11.c: Likewise.
	* gfortran.dg/array_constructor_3.f90: Likewise.
	* gfortran.dg/matmul_bounds_9.f90: Likewise.
	* gfortran.dg/pr78033.f90: Likewise.
	* gfortran.dg/pr96325.f90: Likewise.
---
 gcc/fortran/frontend-passes.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 7d3eae6..93ac4b4 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -373,7 +373,7 @@ optimize_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
   return 0;
 }
 
-/* Auxiliary function to handle the arguments to reduction intrnisics.  If the
+/* Auxiliary function to handle the arguments to reduction intrinsics.  If the
    function is a scalar, just copy it; otherwise returns the new element, the
    old one can be freed.  */
 
-- 
cgit v1.1


From e3948473e927a7c3197ce1a63628fe427f15f6c6 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 23 Apr 2021 00:16:25 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index de0de2e..4764f4a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2021-04-22  Martin Liska  <mliska@suse.cz>
+
+	PR testsuite/100159
+	PR testsuite/100192
+	* frontend-passes.c (optimize_expr): Fix typos and missing comments.
+
+2021-04-22  Michael Meissner  <meissner@linux.ibm.com>
+
+	PR fortran/96983
+	* trans-intrinsic.c (build_round_expr): If int type is larger than
+	long long, do the round and convert to the integer type.  Do not
+	try to find a floating point type the exact size of the integer
+	type.
+
 2021-04-21  Tobias Burnus  <tobias@codesourcery.com>
 
 	* dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset
-- 
cgit v1.1


From 32c4d970ea3a9fc330d6aa8fd83f9dae0b9afc64 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 24 Apr 2021 20:38:06 +0200
Subject: Fortran - allow target of pointer from evaluation of
 function-reference

Fortran allows the target of a pointer from the evaluation of a
function-reference in a variable definition context (e.g. F2018:R902).

gcc/fortran/ChangeLog:

	PR fortran/100218
	* expr.c (gfc_check_vardef_context): Extend check to allow pointer
	from a function reference.

gcc/testsuite/ChangeLog:

	PR fortran/100218
	* gfortran.dg/ptr-func-4.f90: New test.
---
 gcc/fortran/expr.c | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 92a6700..956003e 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -6121,7 +6121,9 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
     }
   if (!pointer && sym->attr.flavor != FL_VARIABLE
       && !(sym->attr.flavor == FL_PROCEDURE && sym == sym->result)
-      && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
+      && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer)
+      && !(sym->attr.flavor == FL_PROCEDURE
+	   && sym->attr.function && sym->attr.pointer))
     {
       if (context)
 	gfc_error ("%qs in variable definition context (%s) at %L is not"
-- 
cgit v1.1


From d0e7833b94953ba6b4a915150666969ad9fc66af Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 24 Apr 2021 20:51:41 +0200
Subject: PR fortran/100154 - ICE in gfc_conv_procedure_call, at
 fortran/trans-expr.c:6131

Add appropriate static checks for the character and status arguments to
the GNU Fortran intrinsic extensions fget[c], fput[c].  Extend variable
check to allow a function reference having a data pointer result.

gcc/fortran/ChangeLog:

	PR fortran/100154
	* check.c (variable_check): Allow function reference having a data
	pointer result.
	(arg_strlen_is_zero): New function.
	(gfc_check_fgetputc_sub): Add static check of character and status
	arguments.
	(gfc_check_fgetput_sub): Likewise.
	* intrinsic.c (add_subroutines): Fix argument name for the
	character argument to intrinsic subroutines fget[c], fput[c].

gcc/testsuite/ChangeLog:

	PR fortran/100154
	* gfortran.dg/pr100154.f90: New test.
---
 gcc/fortran/check.c     | 36 ++++++++++++++++++++++++++++++++++--
 gcc/fortran/intrinsic.c | 10 +++++-----
 2 files changed, 39 insertions(+), 7 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 82db8e4..27bf3a7 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -1055,6 +1055,13 @@ variable_check (gfc_expr *e, int n, bool allow_proc)
 	  return true;
     }
 
+  /* F2018:R902: function reference having a data pointer result.  */
+  if (e->expr_type == EXPR_FUNCTION
+      && e->symtree->n.sym->attr.flavor == FL_PROCEDURE
+      && e->symtree->n.sym->attr.function
+      && e->symtree->n.sym->attr.pointer)
+    return true;
+
   gfc_error ("%qs argument of %qs intrinsic at %L must be a variable",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic, &e->where);
 
@@ -5690,6 +5697,19 @@ gfc_check_spread (gfc_expr *source, gfc_expr *dim, gfc_expr *ncopies)
    functions).  */
 
 bool
+arg_strlen_is_zero (gfc_expr *c, int n)
+{
+  if (gfc_var_strlen (c) == 0)
+    {
+      gfc_error ("%qs argument of %qs intrinsic at %L must have "
+		 "length at least 1", gfc_current_intrinsic_arg[n]->name,
+		 gfc_current_intrinsic, &c->where);
+      return true;
+    }
+  return false;
+}
+
+bool
 gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
 {
   if (!type_check (unit, 0, BT_INTEGER))
@@ -5702,13 +5722,19 @@ gfc_check_fgetputc_sub (gfc_expr *unit, gfc_expr *c, gfc_expr *status)
     return false;
   if (!kind_value_check (c, 1, gfc_default_character_kind))
     return false;
+  if (strcmp (gfc_current_intrinsic, "fgetc") == 0
+      && !variable_check (c, 1, false))
+    return false;
+  if (arg_strlen_is_zero (c, 1))
+    return false;
 
   if (status == NULL)
     return true;
 
   if (!type_check (status, 2, BT_INTEGER)
       || !kind_value_check (status, 2, gfc_default_integer_kind)
-      || !scalar_check (status, 2))
+      || !scalar_check (status, 2)
+      || !variable_check (status, 2, false))
     return false;
 
   return true;
@@ -5729,13 +5755,19 @@ gfc_check_fgetput_sub (gfc_expr *c, gfc_expr *status)
     return false;
   if (!kind_value_check (c, 0, gfc_default_character_kind))
     return false;
+  if (strcmp (gfc_current_intrinsic, "fget") == 0
+      && !variable_check (c, 0, false))
+    return false;
+  if (arg_strlen_is_zero (c, 0))
+    return false;
 
   if (status == NULL)
     return true;
 
   if (!type_check (status, 1, BT_INTEGER)
       || !kind_value_check (status, 1, gfc_default_integer_kind)
-      || !scalar_check (status, 1))
+      || !scalar_check (status, 1)
+      || !variable_check (status, 1, false))
     return false;
 
   return true;
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 17fd92e..219f04f 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -3460,7 +3460,7 @@ add_subroutines (void)
   /* Argument names.  These are used as argument keywords and so need to
      match the documentation.  Please keep this list in sorted order.  */
   static const char
-    *a = "a", *c = "count", *cm = "count_max", *com = "command",
+    *a = "a", *c_ = "c", *c = "count", *cm = "count_max", *com = "command",
     *cr = "count_rate", *dt = "date", *errmsg = "errmsg", *f = "from",
     *fp = "frompos", *gt = "get", *h = "harvest", *han = "handler",
     *length = "length", *ln = "len", *md = "mode", *msk = "mask",
@@ -3840,12 +3840,12 @@ add_subroutines (void)
   add_sym_3s ("fgetc", GFC_ISYM_FGETC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fgetc_sub,
 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
 
   add_sym_2s ("fget", GFC_ISYM_FGET, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetput_sub, NULL, gfc_resolve_fget_sub,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_OUT,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
 
   add_sym_1s ("flush", GFC_ISYM_FLUSH, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
@@ -3855,12 +3855,12 @@ add_subroutines (void)
   add_sym_3s ("fputc", GFC_ISYM_FPUTC, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetputc_sub, NULL, gfc_resolve_fputc_sub,
 	      ut, BT_INTEGER, di, REQUIRED, INTENT_IN,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
 
   add_sym_2s ("fput", GFC_ISYM_FPUT, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
 	      gfc_check_fgetput_sub, NULL, gfc_resolve_fput_sub,
-	      c, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
+	      c_, BT_CHARACTER, dc, REQUIRED, INTENT_IN,
 	      st, BT_INTEGER, di, OPTIONAL, INTENT_OUT);
 
   add_sym_1s ("free", GFC_ISYM_FREE, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
-- 
cgit v1.1


From 502ef97c4f442777e5f61c506d17f8776a69b207 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sun, 25 Apr 2021 00:16:26 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4764f4a..ad66161 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2021-04-24  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100154
+	* check.c (variable_check): Allow function reference having a data
+	pointer result.
+	(arg_strlen_is_zero): New function.
+	(gfc_check_fgetputc_sub): Add static check of character and status
+	arguments.
+	(gfc_check_fgetput_sub): Likewise.
+	* intrinsic.c (add_subroutines): Fix argument name for the
+	character argument to intrinsic subroutines fget[c], fput[c].
+
+2021-04-24  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100218
+	* expr.c (gfc_check_vardef_context): Extend check to allow pointer
+	from a function reference.
+
 2021-04-22  Martin Liska  <mliska@suse.cz>
 
 	PR testsuite/100159
-- 
cgit v1.1


From 22cff118f7526bec195ed6e41452980820fdf3a8 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Fri, 23 Apr 2021 12:23:51 +0200
Subject: Add '-Wopenacc-parallelism'

... to diagnose potentially suboptimal choices regarding OpenACC parallelism.

Not enabled by default: too noisy ("*potentially* suboptimal choices"); see
XFAILed 'dg-bogus'es.

	gcc/c-family/
	* c.opt (Wopenacc-parallelism): New.
	gcc/fortran/
	* lang.opt (Wopenacc-parallelism): New.
	gcc/
	* omp-offload.c (oacc_validate_dims): Implement
	'-Wopenacc-parallelism'.
	* doc/invoke.texi (-Wopenacc-parallelism): Document.
	gcc/testsuite/
	* c-c++-common/goacc/diag-parallelism-1.c: New.
	* c-c++-common/goacc/acc-icf.c: Specify '-Wopenacc-parallelism',
	and match diagnostics, as appropriate.
	* c-c++-common/goacc/classify-kernels-unparallelized.c: Likewise.
	* c-c++-common/goacc/classify-kernels.c: Likewise.
	* c-c++-common/goacc/classify-parallel.c: Likewise.
	* c-c++-common/goacc/classify-routine.c: Likewise.
	* c-c++-common/goacc/classify-serial.c: Likewise.
	* c-c++-common/goacc/kernels-decompose-1.c: Likewise.
	* c-c++-common/goacc/kernels-decompose-2.c: Likewise.
	* c-c++-common/goacc/parallel-dims-1.c: Likewise.
	* c-c++-common/goacc/parallel-reduction.c: Likewise.
	* c-c++-common/goacc/pr70688.c: Likewise.
	* c-c++-common/goacc/routine-1.c: Likewise.
	* c-c++-common/goacc/routine-level-of-parallelism-2.c: Likewise.
	* c-c++-common/goacc/uninit-dim-clause.c: Likewise.
	* gfortran.dg/goacc/classify-kernels-unparallelized.f95: Likewise.
	* gfortran.dg/goacc/classify-kernels.f95: Likewise.
	* gfortran.dg/goacc/classify-parallel.f95: Likewise.
	* gfortran.dg/goacc/classify-routine.f95: Likewise.
	* gfortran.dg/goacc/classify-serial.f95: Likewise.
	* gfortran.dg/goacc/kernels-decompose-1.f95: Likewise.
	* gfortran.dg/goacc/kernels-decompose-2.f95: Likewise.
	* gfortran.dg/goacc/parallel-tree.f95: Likewise.
	* gfortran.dg/goacc/routine-4.f90: Likewise.
	* gfortran.dg/goacc/routine-level-of-parallelism-1.f90: Likewise.
	* gfortran.dg/goacc/routine-module-mod-1.f90: Likewise.
	* gfortran.dg/goacc/routine-multiple-directives-1.f90: Likewise.
	* gfortran.dg/goacc/uninit-dim-clause.f95: Likewise.
	libgomp/
	* testsuite/libgomp.oacc-c-c++-common/firstprivate-1.c: Specify
	'-Wopenacc-parallelism', and match diagnostics, as appropriate.
	* testsuite/libgomp.oacc-c-c++-common/loop-auto-1.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/loop-red-w-1.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/loop-red-w-2.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/loop-w-1.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/mode-transitions.c:
	Likewise.
	* testsuite/libgomp.oacc-c-c++-common/par-reduction-1.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/par-reduction-2.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/parallel-dims.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/parallel-reduction.c:
	Likewise.
	* testsuite/libgomp.oacc-c-c++-common/pr85381-3.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/private-variables.c:
	Likewise.
	* testsuite/libgomp.oacc-c-c++-common/reduction-5.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/reduction-7.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/routine-g-1.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/routine-w-1.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/routine-wv-2.c: Likewise.
	* testsuite/libgomp.oacc-c-c++-common/static-variable-1.c:
	Likewise.
	* testsuite/libgomp.oacc-fortran/optional-private.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/par-reduction-2-1.f: Likewise.
	* testsuite/libgomp.oacc-fortran/par-reduction-2-2.f: Likewise.
	* testsuite/libgomp.oacc-fortran/parallel-dims.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/parallel-reduction.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/pr84028.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/private-variables.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/reduction-1.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/reduction-5.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/reduction-6.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise.

Co-Authored-By: Nathan Sidwell <nathan@codesourcery.com>
Co-Authored-By: Tom de Vries <vries@codesourcery.com>
Co-Authored-By: Julian Brown <julian@codesourcery.com>
Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>
---
 gcc/fortran/lang.opt | 4 ++++
 1 file changed, 4 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 388ef8c..6db01c7 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -285,6 +285,10 @@ Wuse-without-only
 Fortran Var(warn_use_without_only) Warning
 Warn about USE statements that have no ONLY qualifier.
 
+Wopenacc-parallelism
+Fortran
+; Documented in C
+
 Wopenmp-simd
 Fortran
 ; Documented in C
-- 
cgit v1.1


From c0fa3f2fb365144b3a059920aeaf6ff37db1177d Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 27 Apr 2021 00:16:30 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 8 ++++++++
 1 file changed, 8 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ad66161..c368926 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2021-04-26  Thomas Schwinge  <thomas@codesourcery.com>
+	    Nathan Sidwell  <nathan@codesourcery.com>
+	    Tom de Vries  <vries@codesourcery.com>
+	    Julian Brown  <julian@codesourcery.com>
+	    Kwok Cheung Yeung  <kcy@codesourcery.com>
+
+	* lang.opt (Wopenacc-parallelism): New.
+
 2021-04-24  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/100154
-- 
cgit v1.1


From b020cee5af4cb40b9971bfb943d7bd2795b2a3eb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 <jrfsousa@gmail.com>
Date: Wed, 28 Apr 2021 11:20:25 +0000
Subject: Fortran: Fix double function call with -fcheck=pointer [PR]

gcc/fortran/ChangeLog:

	PR fortran/82376
	* trans-expr.c (gfc_conv_procedure_call): Evaluate function result
	and then pass a pointer.

gcc/testsuite/ChangeLog:

	PR fortran/82376
	* gfortran.dg/PR82376.f90: New test.
---
 gcc/fortran/trans-expr.c | 7 ++-----
 1 file changed, 2 insertions(+), 5 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 213f32b..b83b021 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6014,11 +6014,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 			    || (!e->value.function.esym
 				&& e->symtree->n.sym->attr.pointer))
 			&& fsym && fsym->attr.target)
-		{
-		  gfc_conv_expr (&parmse, e);
-		  parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
-		}
-
+		/* Make sure the function only gets called once.  */
+		gfc_conv_expr_reference (&parmse, e, false);
 	      else if (e->expr_type == EXPR_FUNCTION
 		       && e->symtree->n.sym->result
 		       && e->symtree->n.sym->result != e->symtree->n.sym
-- 
cgit v1.1


From e4aefface2a0e34d84b85844b11652eb28f2cf0c Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Wed, 28 Apr 2021 22:35:06 +0200
Subject: Fortran/OpenMP: Fix var-list expr parsing with array/dt

gcc/fortran/ChangeLog:

	* openmp.c (gfc_match_omp_variable_list): Gobble whitespace before
	checking whether a '%' or parenthesis-open follows as next character.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/map-5.f90: New test.
---
 gcc/fortran/openmp.c | 1 +
 1 file changed, 1 insertion(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index a1b0572..7eeabff 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -261,6 +261,7 @@ gfc_match_omp_variable_list (const char *str, gfc_omp_namelist **list,
 	case MATCH_YES:
 	  gfc_expr *expr;
 	  expr = NULL;
+	  gfc_gobble_whitespace ();
 	  if ((allow_sections && gfc_peek_ascii_char () == '(')
 	      || (allow_derived && gfc_peek_ascii_char () == '%'))
 	    {
-- 
cgit v1.1


From e4ff4ffb43d3d8520f1c106e04421f2e6a021c39 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 29 Apr 2021 00:17:01 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 11 +++++++++++
 1 file changed, 11 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c368926..226fd84 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2021-04-28  Tobias Burnus  <tobias@codesourcery.com>
+
+	* openmp.c (gfc_match_omp_variable_list): Gobble whitespace before
+	checking whether a '%' or parenthesis-open follows as next character.
+
+2021-04-28  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
+
+	PR fortran/82376
+	* trans-expr.c (gfc_conv_procedure_call): Evaluate function result
+	and then pass a pointer.
+
 2021-04-26  Thomas Schwinge  <thomas@codesourcery.com>
 	    Nathan Sidwell  <nathan@codesourcery.com>
 	    Tom de Vries  <vries@codesourcery.com>
-- 
cgit v1.1


From 08fff201c92109b5476a4cc211c71de557ec87b1 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 4 May 2021 09:22:36 +0200
Subject: OpenMP/Fortran - fix pasto + testcase in depobj [PR100397]

gcc/fortran/ChangeLog:

	PR testsuite/100397
	* trans-openmp.c (gfc_trans_omp_depobj): Fix pasto in enum values.

libgomp/ChangeLog:

	PR testsuite/100397
	* testsuite/libgomp.fortran/depobj-1.f90 (dep2, dep3): Move var
	declaration to scope of non-'depend'-guarded assignment to avoid races.
---
 gcc/fortran/trans-openmp.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index bf3f261..aa3a82e 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4964,8 +4964,8 @@ gfc_trans_omp_depobj (gfc_code *code)
 	    ? code->ext.omp_clauses->depobj_update : n->u.depend_op)
       {
       case OMP_DEPEND_IN: k = GOMP_DEPEND_IN; break;
-      case OMP_DEPEND_OUT: k = GOMP_DEPEND_IN; break;
-      case OMP_DEPEND_INOUT: k = GOMP_DEPEND_IN; break;
+      case OMP_DEPEND_OUT: k = GOMP_DEPEND_OUT; break;
+      case OMP_DEPEND_INOUT: k = GOMP_DEPEND_INOUT; break;
       case OMP_DEPEND_MUTEXINOUTSET: k = GOMP_DEPEND_MUTEXINOUTSET; break;
       default: gcc_unreachable ();
       }
-- 
cgit v1.1


From 99e8df7a4cc0bb1bfa49e69ccb0f7e02c9755e3c Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 5 May 2021 00:16:54 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 226fd84..9d2d4fa 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2021-05-04  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR testsuite/100397
+	* trans-openmp.c (gfc_trans_omp_depobj): Fix pasto in enum values.
+
 2021-04-28  Tobias Burnus  <tobias@codesourcery.com>
 
 	* openmp.c (gfc_match_omp_variable_list): Gobble whitespace before
-- 
cgit v1.1


From a8b79cc939d6786293f654c42a2d1b0ab040de0e Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 5 May 2021 15:25:50 +0200
Subject: PR fortran/100274 - ICE in gfc_conv_procedure_call, at
 fortran/trans-expr.c:6131

When the check for the length of formal and actual character arguments
found a mismatch and emitted a warning, it would skip further checks
like that could lead to errors.  Fix that by continuing the checking.
Also catch a NULL pointer dereference.

gcc/fortran/ChangeLog:

	PR fortran/100274
	* interface.c (gfc_compare_actual_formal): Continue checks after
	emitting warning for argument length mismatch.
	* trans-expr.c (gfc_conv_procedure_call): Check for NULL pointer
	dereference.

gcc/testsuite/ChangeLog:

	PR fortran/100274
	* gfortran.dg/argument_checking_25.f90: New test.
---
 gcc/fortran/interface.c  | 11 +++++++----
 gcc/fortran/trans-expr.c |  1 +
 2 files changed, 8 insertions(+), 4 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 6073612..9e3e8aa 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3255,10 +3255,13 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  && f->sym->attr.flavor != FL_PROCEDURE)
 	{
 	  if (a->expr->ts.type == BT_CHARACTER && !f->sym->as && where)
-	    gfc_warning (0, "Character length of actual argument shorter "
-			 "than of dummy argument %qs (%lu/%lu) at %L",
-			 f->sym->name, actual_size, formal_size,
-			 &a->expr->where);
+	    {
+	      gfc_warning (0, "Character length of actual argument shorter "
+			   "than of dummy argument %qs (%lu/%lu) at %L",
+			   f->sym->name, actual_size, formal_size,
+			   &a->expr->where);
+	      goto skip_size_check;
+	    }
           else if (where)
 	    {
 	      /* Emit a warning for -std=legacy and an error otherwise. */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b83b021..9389a45 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6125,6 +6125,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		      bool add_clobber;
 		      add_clobber = fsym && fsym->attr.intent == INTENT_OUT
 			&& !fsym->attr.allocatable && !fsym->attr.pointer
+			&& e->symtree && e->symtree->n.sym
 			&& !e->symtree->n.sym->attr.dimension
 			&& !e->symtree->n.sym->attr.pointer
 			&& !e->symtree->n.sym->attr.allocatable
-- 
cgit v1.1


From 449480114aa5ee7e400b75c654f548e38fd03a64 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 6 May 2021 00:16:37 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 8 ++++++++
 1 file changed, 8 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9d2d4fa..17367c4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2021-05-05  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100274
+	* interface.c (gfc_compare_actual_formal): Continue checks after
+	emitting warning for argument length mismatch.
+	* trans-expr.c (gfc_conv_procedure_call): Check for NULL pointer
+	dereference.
+
 2021-05-04  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR testsuite/100397
-- 
cgit v1.1


From a2c593009fef1564dbef2237ee71e9fd08f5361e Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Thu, 6 May 2021 14:41:33 +0100
Subject: Fortran: Assumed and explicit size class arrays [PR46691/99819].

2021-05-06  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran/ChangeLog

	PR fortran/46691
	PR fortran/99819
	* class.c (gfc_build_class_symbol): Remove the error that
	disables assumed size class arrays. Class array types that are
	not deferred shape or assumed rank are given a unique name and
	placed in the procedure namespace.
	* trans-array.c (gfc_trans_g77_array): Obtain the data pointer
	for class arrays.
	(gfc_trans_dummy_array_bias): Suppress the runtime error for
	extent violations in explicit shape class arrays because it
	always fails.
	* trans-expr.c (gfc_conv_procedure_call): Handle assumed size
	class actual arguments passed to non-descriptor formal args by
	using the data pointer, stored as the symbol's backend decl.

gcc/testsuite/ChangeLog

	PR fortran/46691
	PR fortran/99819
	* gfortran.dg/class_dummy_6.f90: New test.
	* gfortran.dg/class_dummy_7.f90: New test.
---
 gcc/fortran/class.c       | 33 +++++++++++++++++++++++++--------
 gcc/fortran/trans-array.c | 12 ++++++++++--
 gcc/fortran/trans-expr.c  |  9 +++++++++
 3 files changed, 44 insertions(+), 10 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 8935321..93118ad 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -630,6 +630,7 @@ gfc_get_len_component (gfc_expr *e, int k)
    component '_vptr' which determines the dynamic type.  When this CLASS
    entity is unlimited polymorphic, then also add a component '_len' to
    store the length of string when that is stored in it.  */
+static int ctr = 0;
 
 bool
 gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
@@ -645,13 +646,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 
   gcc_assert (as);
 
-  if (*as && (*as)->type == AS_ASSUMED_SIZE)
-    {
-      gfc_error ("Assumed size polymorphic objects or components, such "
-		 "as that at %C, have not yet been implemented");
-      return false;
-    }
-
   if (attr->class_ok)
     /* Class container has already been built.  */
     return true;
@@ -693,7 +687,30 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
   else
     ns = ts->u.derived->ns;
 
-  gfc_find_symbol (name, ns, 0, &fclass);
+  /* Although this might seem to be counterintuitive, we can build separate
+     class types with different array specs because the TKR interface checks
+     work on the declared type. All array type other than deferred shape or
+     assumed rank are added to the function namespace to ensure that they
+     are properly distinguished.  */
+  if (attr->dummy && !attr->codimension && (*as)
+      && !((*as)->type == AS_DEFERRED || (*as)->type == AS_ASSUMED_RANK))
+    {
+      char *sname;
+      ns = gfc_current_ns;
+      gfc_find_symbol (name, ns, 0, &fclass);
+      /* If a local class type with this name already exists, update the
+	 name with an index.  */
+      if (fclass)
+	{
+	  fclass = NULL;
+	  sname = xasprintf ("%s_%d", name, ++ctr);
+	  free (name);
+	  name = sname;
+	}
+    }
+  else
+    gfc_find_symbol (name, ns, 0, &fclass);
+
   if (fclass == NULL)
     {
       gfc_symtree *st;
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index e99980f..6d38ea7 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6524,7 +6524,14 @@ gfc_trans_g77_array (gfc_symbol * sym, gfc_wrapped_block * block)
   /* Set the pointer itself if we aren't using the parameter directly.  */
   if (TREE_CODE (parm) != PARM_DECL)
     {
-      tmp = convert (TREE_TYPE (parm), GFC_DECL_SAVED_DESCRIPTOR (parm));
+      tmp = GFC_DECL_SAVED_DESCRIPTOR (parm);
+      if (sym->ts.type == BT_CLASS)
+	{
+	  tmp = build_fold_indirect_ref_loc (input_location, tmp);
+	  tmp = gfc_class_data_get (tmp);
+	  tmp = gfc_conv_descriptor_data_get (tmp);
+	}
+      tmp = convert (TREE_TYPE (parm), tmp);
       gfc_add_modify (&init, parm, tmp);
     }
   stmt = gfc_finish_block (&init);
@@ -6626,7 +6633,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc,
       && VAR_P (sym->ts.u.cl->backend_decl))
     gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
 
-  checkparm = (as->type == AS_EXPLICIT
+  /* TODO: Fix the exclusion of class arrays from extent checking.  */
+  checkparm = (as->type == AS_EXPLICIT && !is_classarray
 	       && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
 
   no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc)
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9389a45..7e3de41 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6418,6 +6418,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				fsym ? fsym->attr.intent : INTENT_INOUT,
 				fsym && fsym->attr.pointer);
 
+	      else if (e->ts.type == BT_CLASS && CLASS_DATA (e)->as
+		       && CLASS_DATA (e)->as->type == AS_ASSUMED_SIZE
+		       && nodesc_arg && fsym->ts.type == BT_DERIVED)
+		/* An assumed size class actual argument being passed to
+		   a 'no descriptor' formal argument just requires the
+		   data pointer to be passed. For class dummy arguments
+		   this is stored in the symbol backend decl..  */
+		parmse.expr = e->symtree->n.sym->backend_decl;
+
 	      else if (gfc_is_class_array_ref (e, NULL)
 		       && fsym && fsym->ts.type == BT_DERIVED)
 		/* The actual argument is a component reference to an
-- 
cgit v1.1


From cfe82a0cbe72baa723f7d89502cdf59c0e87fff4 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 7 May 2021 00:16:33 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 17367c4..042f532 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2021-05-06  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/46691
+	PR fortran/99819
+	* class.c (gfc_build_class_symbol): Remove the error that
+	disables assumed size class arrays. Class array types that are
+	not deferred shape or assumed rank are given a unique name and
+	placed in the procedure namespace.
+	* trans-array.c (gfc_trans_g77_array): Obtain the data pointer
+	for class arrays.
+	(gfc_trans_dummy_array_bias): Suppress the runtime error for
+	extent violations in explicit shape class arrays because it
+	always fails.
+	* trans-expr.c (gfc_conv_procedure_call): Handle assumed size
+	class actual arguments passed to non-descriptor formal args by
+	using the data pointer, stored as the symbol's backend decl.
+
 2021-05-05  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/100274
-- 
cgit v1.1


From 56103737f1731616dfbe500fad2c0bb3cc084238 Mon Sep 17 00:00:00 2001
From: Paul Thomas <pault@gcc.gnu.org>
Date: Sat, 8 May 2021 12:12:48 +0100
Subject: Correct ChangeLob entries for PR46991

---
 gcc/fortran/ChangeLog | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 042f532..01989e8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,6 +1,6 @@
 2021-05-06  Paul Thomas  <pault@gcc.gnu.org>
 
-	PR fortran/46691
+	PR fortran/46991
 	PR fortran/99819
 	* class.c (gfc_build_class_symbol): Remove the error that
 	disables assumed size class arrays. Class array types that are
-- 
cgit v1.1


From 6ba3079dce89d9b63bf5dbd5e320ea2bf96f196b Mon Sep 17 00:00:00 2001
From: Martin Liska <mliska@suse.cz>
Date: Wed, 17 Mar 2021 16:36:44 +0100
Subject: Come up with startswith function.

gcc/ada/ChangeLog:

	* gcc-interface/utils.c (def_builtin_1): Use startswith
	function instead of strncmp.

gcc/analyzer/ChangeLog:

	* sm-file.cc (is_file_using_fn_p): Use startswith
	function instead of strncmp.

gcc/ChangeLog:

	* builtins.c (is_builtin_name): Use startswith
	function instead of strncmp.
	* collect2.c (main): Likewise.
	(has_lto_section): Likewise.
	(scan_libraries): Likewise.
	* coverage.c (coverage_checksum_string): Likewise.
	(coverage_init): Likewise.
	* dwarf2out.c (is_cxx): Likewise.
	(gen_compile_unit_die): Likewise.
	* gcc-ar.c (main): Likewise.
	* gcc.c (init_spec): Likewise.
	(read_specs): Likewise.
	(execute): Likewise.
	(check_live_switch): Likewise.
	* genattrtab.c (write_attr_case): Likewise.
	(IS_ATTR_GROUP): Likewise.
	* gencfn-macros.c (main): Likewise.
	* gengtype.c (type_for_name): Likewise.
	(gen_rtx_next): Likewise.
	(get_file_langdir): Likewise.
	(write_local): Likewise.
	* genmatch.c (get_operator): Likewise.
	(get_operand_type): Likewise.
	(expr::gen_transform): Likewise.
	* genoutput.c (validate_optab_operands): Likewise.
	* incpath.c (add_sysroot_to_chain): Likewise.
	* langhooks.c (lang_GNU_C): Likewise.
	(lang_GNU_CXX): Likewise.
	(lang_GNU_Fortran): Likewise.
	(lang_GNU_OBJC): Likewise.
	* lto-wrapper.c (run_gcc): Likewise.
	* omp-general.c (omp_max_simt_vf): Likewise.
	* omp-low.c (omp_runtime_api_call): Likewise.
	* opts-common.c (parse_options_from_collect_gcc_options): Likewise.
	* read-rtl-function.c (function_reader::read_rtx_operand_r): Likewise.
	* real.c (real_from_string): Likewise.
	* selftest.c (assert_str_startswith): Likewise.
	* timevar.c (timer::validate_phases): Likewise.
	* tree.c (get_file_function_name): Likewise.
	* ubsan.c (ubsan_use_new_style_p): Likewise.
	* varasm.c (default_function_rodata_section): Likewise.
	(incorporeal_function_p): Likewise.
	(default_section_type_flags): Likewise.
	* system.h (startswith): Define startswith.

gcc/c-family/ChangeLog:

	* c-ada-spec.c (print_destructor): Use startswith
	function instead of strncmp.
	(dump_ada_declaration): Likewise.
	* c-common.c (disable_builtin_function): Likewise.
	(def_builtin_1): Likewise.
	* c-format.c (check_tokens): Likewise.
	(check_plain): Likewise.
	(convert_format_name_to_system_name): Likewise.

gcc/c/ChangeLog:

	* c-aux-info.c (affix_data_type): Use startswith
	function instead of strncmp.
	* c-typeck.c (build_function_call_vec): Likewise.
	* gimple-parser.c (c_parser_gimple_parse_bb_spec): Likewise.

gcc/cp/ChangeLog:

	* decl.c (duplicate_decls): Use startswith
	function instead of strncmp.
	(cxx_builtin_function): Likewise.
	(omp_declare_variant_finalize_one): Likewise.
	(grokfndecl): Likewise.
	* error.c (dump_decl_name): Likewise.
	* mangle.c (find_decomp_unqualified_name): Likewise.
	(write_guarded_var_name): Likewise.
	(decl_tls_wrapper_p): Likewise.
	* parser.c (cp_parser_simple_type_specifier): Likewise.
	(cp_parser_tx_qualifier_opt): Likewise.
	* pt.c (template_parm_object_p): Likewise.
	(dguide_name_p): Likewise.

gcc/d/ChangeLog:

	* d-builtins.cc (do_build_builtin_fn): Use startswith
	function instead of strncmp.
	* dmd/dinterpret.c (evaluateIfBuiltin): Likewise.
	* dmd/dmangle.c: Likewise.
	* dmd/hdrgen.c: Likewise.
	* dmd/identifier.c (Identifier::toHChars2): Likewise.

gcc/fortran/ChangeLog:

	* decl.c (variable_decl): Use startswith
	function instead of strncmp.
	(gfc_match_end): Likewise.
	* gfortran.h (gfc_str_startswith): Likewise.
	* module.c (load_omp_udrs): Likewise.
	(read_module): Likewise.
	* options.c (gfc_handle_runtime_check_option): Likewise.
	* primary.c (match_arg_list_function): Likewise.
	* trans-decl.c (gfc_get_symbol_decl): Likewise.
	* trans-expr.c (gfc_conv_procedure_call): Likewise.
	* trans-intrinsic.c (gfc_conv_ieee_arithmetic_function): Likewise.

gcc/go/ChangeLog:

	* gofrontend/runtime.cc (Runtime::name_to_code): Use startswith
	function instead of strncmp.

gcc/objc/ChangeLog:

	* objc-act.c (objc_string_ref_type_p): Use startswith
	function instead of strncmp.
	* objc-encoding.c (encode_type): Likewise.
	* objc-next-runtime-abi-02.c (has_load_impl): Likewise.
---
 gcc/fortran/decl.c            |  4 ++--
 gcc/fortran/gfortran.h        |  4 ----
 gcc/fortran/module.c          | 10 +++++-----
 gcc/fortran/options.c         |  2 +-
 gcc/fortran/primary.c         |  6 +++---
 gcc/fortran/trans-decl.c      |  2 +-
 gcc/fortran/trans-expr.c      |  2 +-
 gcc/fortran/trans-intrinsic.c | 22 +++++++++++-----------
 8 files changed, 24 insertions(+), 28 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 947e4f8..413c7a7 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2721,7 +2721,7 @@ variable_decl (int elem)
     }
 
   /* %FILL components may not have initializers.  */
-  if (gfc_str_startswith (name, "%FILL") && gfc_match_eos () != MATCH_YES)
+  if (startswith (name, "%FILL") && gfc_match_eos () != MATCH_YES)
     {
       gfc_error ("%qs entity cannot have an initializer at %C", "%FILL");
       m = MATCH_ERROR;
@@ -8221,7 +8221,7 @@ gfc_match_end (gfc_statement *st)
     {
     case COMP_ASSOCIATE:
     case COMP_BLOCK:
-      if (gfc_str_startswith (block_name, "block@"))
+      if (startswith (block_name, "block@"))
 	block_name = NULL;
       break;
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index d12be0c..4f5d2f8 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3518,10 +3518,6 @@ bool gfc_is_compile_time_shape (gfc_array_spec *);
 
 bool gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *);
 
-
-#define gfc_str_startswith(str, pref) \
-	(strncmp ((str), (pref), strlen (pref)) == 0)
-
 /* interface.c -- FIXME: some of these should be in symbol.c */
 void gfc_free_interface (gfc_interface *);
 bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 089453c..321d3256 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -5029,7 +5029,7 @@ load_omp_udrs (void)
       mio_pool_string (&name);
       gfc_clear_ts (&ts);
       mio_typespec (&ts);
-      if (gfc_str_startswith (name, "operator "))
+      if (startswith (name, "operator "))
 	{
 	  const char *p = name + sizeof ("operator ") - 1;
 	  if (strcmp (p, "+") == 0)
@@ -5477,8 +5477,8 @@ read_module (void)
 
 	  /* Exception: Always import vtabs & vtypes.  */
 	  if (p == NULL && name[0] == '_'
-	      && (gfc_str_startswith (name, "__vtab_")
-		  || gfc_str_startswith (name, "__vtype_")))
+	      && (startswith (name, "__vtab_")
+		  || startswith (name, "__vtype_")))
 	    p = name;
 
 	  /* Skip symtree nodes not in an ONLY clause, unless there
@@ -5563,8 +5563,8 @@ read_module (void)
 		sym->attr.use_rename = 1;
 
 	      if (name[0] != '_'
-		  || (!gfc_str_startswith (name, "__vtab_")
-		      && !gfc_str_startswith (name, "__vtype_")))
+		  || (!startswith (name, "__vtab_")
+		      && !startswith (name, "__vtype_")))
 		sym->attr.use_only = only_flag;
 
 	      /* Store the symtree pointing to this symbol.  */
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 3a0b98b..1723f68 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -615,7 +615,7 @@ gfc_handle_runtime_check_option (const char *arg)
 	      result = 1;
 	      break;
 	    }
-	  else if (optname[n] && pos > 3 && gfc_str_startswith (arg, "no-")
+	  else if (optname[n] && pos > 3 && startswith (arg, "no-")
 		   && strncmp (optname[n], arg+3, pos-3) == 0)
 	    {
 	      gfc_option.rtcheck &= ~optmask[n];
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index a6df885..9fe8d1e 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1786,21 +1786,21 @@ match_arg_list_function (gfc_actual_arglist *result)
       switch (name[0])
 	{
 	case 'l':
-	  if (gfc_str_startswith (name, "loc"))
+	  if (startswith (name, "loc"))
 	    {
 	      result->name = "%LOC";
 	      break;
 	    }
 	  /* FALLTHRU */
 	case 'r':
-	  if (gfc_str_startswith (name, "ref"))
+	  if (startswith (name, "ref"))
 	    {
 	      result->name = "%REF";
 	      break;
 	    }
 	  /* FALLTHRU */
 	case 'v':
-	  if (gfc_str_startswith (name, "val"))
+	  if (startswith (name, "val"))
 	    {
 	      result->name = "%VAL";
 	      break;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cc9d855..a170188 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1941,7 +1941,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
      Marking this as artificial means that OpenMP will treat this as
      predetermined shared.  */
 
-  bool def_init = gfc_str_startswith (sym->name, "__def_init");
+  bool def_init = startswith (sym->name, "__def_init");
 
   if (sym->attr.vtab || def_init)
     {
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 7e3de41..cce18d0 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -6847,7 +6847,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       /* When calling __copy for character expressions to unlimited
 	 polymorphic entities, the dst argument needs a string length.  */
       if (sym->name[0] == '_' && e && e->ts.type == BT_CHARACTER
-	  && gfc_str_startswith (sym->name, "__vtab_CHARACTER")
+	  && startswith (sym->name, "__vtab_CHARACTER")
 	  && arg->next && arg->next->expr
 	  && (arg->next->expr->ts.type == BT_DERIVED
 	      || arg->next->expr->ts.type == BT_CLASS)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index cceef8f..4d74514 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -10062,27 +10062,27 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr)
 {
   const char *name = expr->value.function.name;
 
-  if (gfc_str_startswith (name, "_gfortran_ieee_is_nan"))
+  if (startswith (name, "_gfortran_ieee_is_nan"))
     conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISNAN, 1);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_is_finite"))
+  else if (startswith (name, "_gfortran_ieee_is_finite"))
     conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISFINITE, 1);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_unordered"))
+  else if (startswith (name, "_gfortran_ieee_unordered"))
     conv_intrinsic_ieee_builtin (se, expr, BUILT_IN_ISUNORDERED, 2);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_is_normal"))
+  else if (startswith (name, "_gfortran_ieee_is_normal"))
     conv_intrinsic_ieee_is_normal (se, expr);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_is_negative"))
+  else if (startswith (name, "_gfortran_ieee_is_negative"))
     conv_intrinsic_ieee_is_negative (se, expr);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_copy_sign"))
+  else if (startswith (name, "_gfortran_ieee_copy_sign"))
     conv_intrinsic_ieee_copy_sign (se, expr);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_scalb"))
+  else if (startswith (name, "_gfortran_ieee_scalb"))
     conv_intrinsic_ieee_scalb (se, expr);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_next_after"))
+  else if (startswith (name, "_gfortran_ieee_next_after"))
     conv_intrinsic_ieee_next_after (se, expr);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_rem"))
+  else if (startswith (name, "_gfortran_ieee_rem"))
     conv_intrinsic_ieee_rem (se, expr);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_logb"))
+  else if (startswith (name, "_gfortran_ieee_logb"))
     conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_LOGB);
-  else if (gfc_str_startswith (name, "_gfortran_ieee_rint"))
+  else if (startswith (name, "_gfortran_ieee_rint"))
     conv_intrinsic_ieee_logb_rint (se, expr, BUILT_IN_RINT);
   else
     /* It is not among the functions we translate directly.  We return
-- 
cgit v1.1


From aa891c56f25baac94db004e309d1b6e40b770a95 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 11 May 2021 00:16:36 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 01989e8..71cc3d8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2021-05-10  Martin Liska  <mliska@suse.cz>
+
+	* decl.c (variable_decl): Use startswith
+	function instead of strncmp.
+	(gfc_match_end): Likewise.
+	* gfortran.h (gfc_str_startswith): Likewise.
+	* module.c (load_omp_udrs): Likewise.
+	(read_module): Likewise.
+	* options.c (gfc_handle_runtime_check_option): Likewise.
+	* primary.c (match_arg_list_function): Likewise.
+	* trans-decl.c (gfc_get_symbol_decl): Likewise.
+	* trans-expr.c (gfc_conv_procedure_call): Likewise.
+	* trans-intrinsic.c (gfc_conv_ieee_arithmetic_function): Likewise.
+
 2021-05-06  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/46991
-- 
cgit v1.1


From 62e1bd651f60cfe3daaad91b41b7612bc7fa7460 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 14 May 2021 19:19:26 +0200
Subject: Fortran/OpenMP: Handle implicit SAVE for variables in main

gcc/fortran/ChangeLog:

	* resolve.c (resolve_symbol): Handle implicit SAVE of main-program
	for vars in 'omp threadprivate' and 'omp declare target'.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/implicit-save.f90: New test.
---
 gcc/fortran/resolve.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5a81387..83b41a3 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -16039,7 +16039,8 @@ resolve_symbol (gfc_symbol *sym)
       && !(sym->ns->save_all && !sym->attr.automatic)
       && sym->module == NULL
       && (sym->ns->proc_name == NULL
-	  || sym->ns->proc_name->attr.flavor != FL_MODULE))
+	  || (sym->ns->proc_name->attr.flavor != FL_MODULE
+	      && !sym->ns->proc_name->attr.is_main_program)))
     gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at);
 
   /* Check omp declare target restrictions.  */
@@ -16050,7 +16051,8 @@ resolve_symbol (gfc_symbol *sym)
       && (!sym->attr.in_common
 	  && sym->module == NULL
 	  && (sym->ns->proc_name == NULL
-	      || sym->ns->proc_name->attr.flavor != FL_MODULE)))
+	      || (sym->ns->proc_name->attr.flavor != FL_MODULE
+		  && !sym->ns->proc_name->attr.is_main_program))))
     gfc_error ("!$OMP DECLARE TARGET variable %qs at %L isn't SAVEd",
 	       sym->name, &sym->declared_at);
 
-- 
cgit v1.1


From 0e3702f8daeec5897982d185650b78a5c1c53c25 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 14 May 2021 19:21:47 +0200
Subject: Fortran/OpenMP: Support 'omp parallel master'

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
	EXEC_OMP_PARALLEL_MASTER.
	* frontend-passes.c (gfc_code_walker): Likewise.
	* gfortran.h (enum gfc_statement): Add ST_OMP_PARALLEL_MASTER and
	ST_OMP_END_PARALLEL_MASTER.
	(enum gfc_exec_op): Add EXEC_OMP_PARALLEL_MASTER..
	* match.h (gfc_match_omp_parallel_master): Handle it.
	* openmp.c (gfc_match_omp_parallel_master, resolve_omp_clauses,
	omp_code_to_statement, gfc_resolve_omp_directive): Likewise.
	* parse.c (decode_omp_directive, case_exec_markers,
	gfc_ascii_statement, parse_omp_structured_block,
	parse_executable): Likewise.
	* resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise.
	* st.c (gfc_free_statement): Likewise.
	* trans-openmp.c (gfc_trans_omp_parallel_master,
	gfc_trans_omp_workshare, gfc_trans_omp_directive): Likewise.
	* trans.c (trans_code): Likewise.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/parallel-master.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/parallel-master-1.f90: New test.
	* gfortran.dg/gomp/parallel-master-2.f90: New test.
---
 gcc/fortran/dump-parse-tree.c |  3 +++
 gcc/fortran/frontend-passes.c |  1 +
 gcc/fortran/gfortran.h        |  6 ++++--
 gcc/fortran/match.h           |  1 +
 gcc/fortran/openmp.c          | 11 +++++++++++
 gcc/fortran/parse.c           | 17 ++++++++++++++++-
 gcc/fortran/resolve.c         |  3 +++
 gcc/fortran/st.c              |  1 +
 gcc/fortran/trans-openmp.c    | 25 +++++++++++++++++++++++++
 gcc/fortran/trans.c           |  1 +
 10 files changed, 66 insertions(+), 3 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index b50265a..874e6d4 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1856,6 +1856,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
     case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
     case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
+    case EXEC_OMP_PARALLEL_MASTER: name = "PARALLEL MASTER"; break;
     case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
     case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
     case EXEC_OMP_SCAN: name = "SCAN"; break;
@@ -1927,6 +1928,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
@@ -3139,6 +3141,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 93ac4b4..ffe2db4 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5542,6 +5542,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	    case EXEC_OMP_PARALLEL:
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_DO_SIMD:
+	    case EXEC_OMP_PARALLEL_MASTER:
 	    case EXEC_OMP_PARALLEL_SECTIONS:
 
 	      in_omp_workshare = false;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4f5d2f8..bab785b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -266,7 +266,8 @@ enum gfc_statement
   ST_OMP_REQUIRES, ST_PROCEDURE, ST_GENERIC, ST_CRITICAL, ST_END_CRITICAL,
   ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
   ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM,
-  ST_END_TEAM, ST_SYNC_TEAM, ST_NONE
+  ST_END_TEAM, ST_SYNC_TEAM,  ST_OMP_PARALLEL_MASTER,
+  ST_OMP_END_PARALLEL_MASTER, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -2704,7 +2705,8 @@ enum gfc_exec_op
   EXEC_OMP_TARGET_ENTER_DATA, EXEC_OMP_TARGET_EXIT_DATA,
   EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO,
   EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD,
-  EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ
+  EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ,
+  EXEC_OMP_PARALLEL_MASTER
 };
 
 typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index b72ec67..09c5723 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -174,6 +174,7 @@ match gfc_match_omp_ordered_depend (void);
 match gfc_match_omp_parallel (void);
 match gfc_match_omp_parallel_do (void);
 match gfc_match_omp_parallel_do_simd (void);
+match gfc_match_omp_parallel_master (void);
 match gfc_match_omp_parallel_sections (void);
 match gfc_match_omp_parallel_workshare (void);
 match gfc_match_omp_requires (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 7eeabff..294b6d0 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -3770,6 +3770,13 @@ gfc_match_omp_parallel_do_simd (void)
 
 
 match
+gfc_match_omp_parallel_master (void)
+{
+  return match_omp (EXEC_OMP_PARALLEL_MASTER, OMP_PARALLEL_CLAUSES);
+}
+
+
+match
 gfc_match_omp_parallel_sections (void)
 {
   return match_omp (EXEC_OMP_PARALLEL_SECTIONS,
@@ -4833,6 +4840,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 
 	    case EXEC_OMP_PARALLEL:
 	    case EXEC_OMP_PARALLEL_DO:
+	    case EXEC_OMP_PARALLEL_MASTER:
 	    case EXEC_OMP_PARALLEL_SECTIONS:
 	    case EXEC_OMP_PARALLEL_WORKSHARE:
 	    case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
@@ -6796,6 +6804,8 @@ omp_code_to_statement (gfc_code *code)
     {
     case EXEC_OMP_PARALLEL:
       return ST_OMP_PARALLEL;
+    case EXEC_OMP_PARALLEL_MASTER:
+      return ST_OMP_PARALLEL_MASTER;
     case EXEC_OMP_PARALLEL_SECTIONS:
       return ST_OMP_PARALLEL_SECTIONS;
     case EXEC_OMP_SECTIONS:
@@ -7312,6 +7322,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_PARALLEL:
+    case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_SECTIONS:
     case EXEC_OMP_SINGLE:
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 9bbe9e8..6efb3fd 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -925,6 +925,8 @@ decode_omp_directive (void)
       matchs ("end parallel do simd", gfc_match_omp_eos_error,
 	      ST_OMP_END_PARALLEL_DO_SIMD);
       matcho ("end parallel do", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO);
+      matcho ("end parallel master", gfc_match_omp_eos_error,
+	      ST_OMP_END_PARALLEL_MASTER);
       matcho ("end parallel sections", gfc_match_omp_eos_error,
 	      ST_OMP_END_PARALLEL_SECTIONS);
       matcho ("end parallel workshare", gfc_match_omp_eos_error,
@@ -990,6 +992,8 @@ decode_omp_directive (void)
       matchs ("parallel do simd", gfc_match_omp_parallel_do_simd,
 	      ST_OMP_PARALLEL_DO_SIMD);
       matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
+      matcho ("parallel master", gfc_match_omp_parallel_master,
+	      ST_OMP_PARALLEL_MASTER);
       matcho ("parallel sections", gfc_match_omp_parallel_sections,
 	      ST_OMP_PARALLEL_SECTIONS);
       matcho ("parallel workshare", gfc_match_omp_parallel_workshare,
@@ -1605,7 +1609,7 @@ next_statement (void)
 #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \
   case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \
   case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \
-  case ST_SELECT_RANK: case ST_OMP_PARALLEL: \
+  case ST_SELECT_RANK: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASTER: \
   case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \
   case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
   case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
@@ -2349,6 +2353,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_PARALLEL_DO_SIMD:
       p = "!$OMP END PARALLEL DO SIMD";
       break;
+    case ST_OMP_END_PARALLEL_MASTER:
+      p = "!$OMP END PARALLEL MASTER";
+      break;
     case ST_OMP_END_PARALLEL_SECTIONS:
       p = "!$OMP END PARALLEL SECTIONS";
       break;
@@ -2443,6 +2450,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_PARALLEL_DO_SIMD:
       p = "!$OMP PARALLEL DO SIMD";
       break;
+    case ST_OMP_PARALLEL_MASTER:
+      p = "!$OMP PARALLEL MASTER";
+      break;
     case ST_OMP_PARALLEL_SECTIONS:
       p = "!$OMP PARALLEL SECTIONS";
       break;
@@ -5255,6 +5265,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_PARALLEL:
       omp_end_st = ST_OMP_END_PARALLEL;
       break;
+    case ST_OMP_PARALLEL_MASTER:
+      omp_end_st = ST_OMP_END_PARALLEL_MASTER;
+      break;
     case ST_OMP_PARALLEL_SECTIONS:
       omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
       break;
@@ -5379,6 +5392,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 		  break;
 
 		case ST_OMP_PARALLEL:
+		case ST_OMP_PARALLEL_MASTER:
 		case ST_OMP_PARALLEL_SECTIONS:
 		  parse_omp_structured_block (st, false);
 		  break;
@@ -5580,6 +5594,7 @@ parse_executable (gfc_statement st)
 	  break;
 
 	case ST_OMP_PARALLEL:
+	case ST_OMP_PARALLEL_MASTER:
 	case ST_OMP_PARALLEL_SECTIONS:
 	case ST_OMP_SECTIONS:
 	case ST_OMP_ORDERED:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 83b41a3..c02bbed 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10802,6 +10802,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
+	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_SECTIONS:
 	case EXEC_OMP_PARALLEL_WORKSHARE:
 	case EXEC_OMP_SECTIONS:
@@ -11763,6 +11764,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
 	    case EXEC_OMP_PARALLEL:
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_DO_SIMD:
+	    case EXEC_OMP_PARALLEL_MASTER:
 	    case EXEC_OMP_PARALLEL_SECTIONS:
 	    case EXEC_OMP_TARGET_PARALLEL:
 	    case EXEC_OMP_TARGET_PARALLEL_DO:
@@ -12243,6 +12245,7 @@ start:
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
+	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_SECTIONS:
 	case EXEC_OMP_PARALLEL_WORKSHARE:
 	  omp_workshare_save = omp_workshare_flag;
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 9e76199..02a81da 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -230,6 +230,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index aa3a82e..5666cd6 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -5554,6 +5554,28 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
 }
 
 static tree
+gfc_trans_omp_parallel_master (gfc_code *code)
+{
+  stmtblock_t block;
+  tree stmt, omp_clauses;
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+				       code->loc);
+  pushlevel ();
+  stmt = gfc_trans_omp_master (code);
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
+  else
+    poplevel (0, 0);
+  stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
+		     void_type_node, stmt, omp_clauses);
+  OMP_PARALLEL_COMBINED (stmt) = 1;
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
 gfc_trans_omp_parallel_sections (gfc_code *code)
 {
   stmtblock_t block;
@@ -6092,6 +6114,7 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
 
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
+	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_SECTIONS:
 	case EXEC_OMP_PARALLEL_WORKSHARE:
 	case EXEC_OMP_CRITICAL:
@@ -6273,6 +6296,8 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_parallel_do (code, NULL, NULL);
     case EXEC_OMP_PARALLEL_DO_SIMD:
       return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
+    case EXEC_OMP_PARALLEL_MASTER:
+      return gfc_trans_omp_parallel_master (code);
     case EXEC_OMP_PARALLEL_SECTIONS:
       return gfc_trans_omp_parallel_sections (code);
     case EXEC_OMP_PARALLEL_WORKSHARE:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 624c713..9f296bd 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2174,6 +2174,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
+	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_SECTIONS:
 	case EXEC_OMP_PARALLEL_WORKSHARE:
 	case EXEC_OMP_SECTIONS:
-- 
cgit v1.1


From 87a7d10c2e9ec34a276e6acb5d2282a35b9cfafb Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 15 May 2021 00:16:27 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 71cc3d8..781dedd 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,28 @@
+2021-05-14  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
+	EXEC_OMP_PARALLEL_MASTER.
+	* frontend-passes.c (gfc_code_walker): Likewise.
+	* gfortran.h (enum gfc_statement): Add ST_OMP_PARALLEL_MASTER and
+	ST_OMP_END_PARALLEL_MASTER.
+	(enum gfc_exec_op): Add EXEC_OMP_PARALLEL_MASTER..
+	* match.h (gfc_match_omp_parallel_master): Handle it.
+	* openmp.c (gfc_match_omp_parallel_master, resolve_omp_clauses,
+	omp_code_to_statement, gfc_resolve_omp_directive): Likewise.
+	* parse.c (decode_omp_directive, case_exec_markers,
+	gfc_ascii_statement, parse_omp_structured_block,
+	parse_executable): Likewise.
+	* resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise.
+	* st.c (gfc_free_statement): Likewise.
+	* trans-openmp.c (gfc_trans_omp_parallel_master,
+	gfc_trans_omp_workshare, gfc_trans_omp_directive): Likewise.
+	* trans.c (trans_code): Likewise.
+
+2021-05-14  Tobias Burnus  <tobias@codesourcery.com>
+
+	* resolve.c (resolve_symbol): Handle implicit SAVE of main-program
+	for vars in 'omp threadprivate' and 'omp declare target'.
+
 2021-05-10  Martin Liska  <mliska@suse.cz>
 
 	* decl.c (variable_decl): Use startswith
-- 
cgit v1.1


From 582776eb1b62c32f5234566a01ea92247b7d6bcc Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 17 May 2021 13:20:27 +0200
Subject: OpenMP/Fortran: Reject nonintrinsic assignments in OMP WORKSHARE
 [PR100633]

	PR fortran/100633

gcc/fortran/ChangeLog:

	* resolve.c (gfc_resolve_code): Reject nonintrinsic assignments in
	OMP WORKSHARE.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/workshare-59.f90: New test.
---
 gcc/fortran/resolve.c | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index c02bbed..747516f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11940,6 +11940,12 @@ start:
 
 	  if (resolve_ordinary_assign (code, ns))
 	    {
+	      if (omp_workshare_flag)
+		{
+		  gfc_error ("Expected intrinsic assignment in OMP WORKSHARE "
+			     "at %L", &code->loc);
+		  break;
+		}
 	      if (code->op == EXEC_COMPCALL)
 		goto compcall;
 	      else
-- 
cgit v1.1


From 09867aa0ef7568012650395189b735f9a34cf9b5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 17 May 2021 21:35:38 +0200
Subject: PR fortran/98411 - Pointless warning for static variables

Variables with explicit SAVE attribute cannot end up on the stack.
There is no point in checking whether they should be moved off the
stack to static storage.

gcc/fortran/ChangeLog:

	PR fortran/98411
	* trans-decl.c (gfc_finish_var_decl): Add check for explicit SAVE
	attribute.

gcc/testsuite/ChangeLog:

	PR fortran/98411
	* gfortran.dg/pr98411.f90: New test.
---
 gcc/fortran/trans-decl.c | 1 +
 1 file changed, 1 insertion(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index a170188..406b4ae 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -738,6 +738,7 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
   /* Keep variables larger than max-stack-var-size off stack.  */
   if (!(sym->ns->proc_name && sym->ns->proc_name->attr.recursive)
       && !sym->attr.automatic
+      && sym->attr.save != SAVE_EXPLICIT
       && INTEGER_CST_P (DECL_SIZE_UNIT (decl))
       && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
 	 /* Put variable length auto array pointers always into stack.  */
-- 
cgit v1.1


From a7ffc1ef6e38c01037c8894a6bc1889d6f875444 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 18 May 2021 00:16:40 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 781dedd..54fa0ee 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2021-05-17  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/98411
+	* trans-decl.c (gfc_finish_var_decl): Add check for explicit SAVE
+	attribute.
+
+2021-05-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/100633
+	* resolve.c (gfc_resolve_code): Reject nonintrinsic assignments in
+	OMP WORKSHARE.
+
 2021-05-14  Tobias Burnus  <tobias@codesourcery.com>
 
 	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
-- 
cgit v1.1


From cc193ac840d58ee0ffb57b14b542706cde3db0e7 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 18 May 2021 16:40:45 +0200
Subject: Fortran/OpenMP: Add missing EXEC_OMP_DEPOBJ case val [PR100642]

	PR fortran/100642

gcc/fortran/ChangeLog:

	* openmp.c (omp_code_to_statement): Add missing EXEC_OMP_DEPOBJ.

gcc/testsuite/ChangeLog:

	* gfortran.dg/goacc-gomp/depobj.f90: New test.
---
 gcc/fortran/openmp.c | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 294b6d0..005b6c1 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -6902,7 +6902,8 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_PARALLEL_DO;
     case EXEC_OMP_PARALLEL_DO_SIMD:
       return ST_OMP_PARALLEL_DO_SIMD;
-
+    case EXEC_OMP_DEPOBJ:
+      return ST_OMP_DEPOBJ;
     default:
       gcc_unreachable ();
     }
-- 
cgit v1.1


From a8daf9a19a5eae6b98acede14bb6c27b2e0038e0 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 19 May 2021 00:16:45 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 54fa0ee..aa8426f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2021-05-18  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/100642
+	* openmp.c (omp_code_to_statement): Add missing EXEC_OMP_DEPOBJ.
+
 2021-05-17  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/98411
-- 
cgit v1.1


From cdcec2f8505ea12c2236cf0184d77dd2f5de4832 Mon Sep 17 00:00:00 2001
From: Marcel Vollweiler <marcel@codesourcery.com>
Date: Thu, 20 May 2021 08:52:34 -0700
Subject: Fortran/OpenMP: Add support for 'close' in map clause

gcc/fortran/ChangeLog:

	* openmp.c (gfc_match_omp_clauses): Support map-type-modifier 'close'.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/map-6.f90: New test.
	* gfortran.dg/gomp/map-7.f90: New test.
	* gfortran.dg/gomp/map-8.f90: New test.
---
 gcc/fortran/openmp.c | 55 ++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 45 insertions(+), 10 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 005b6c1..cf4d7ba 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1710,27 +1710,62 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      && gfc_match ("map ( ") == MATCH_YES)
 	    {
 	      locus old_loc2 = gfc_current_locus;
-	      bool always = false;
+	      int always_modifier = 0;
+	      int close_modifier = 0;
+	      locus second_always_locus = old_loc2;
+	      locus second_close_locus = old_loc2;
+
+	      for (;;)
+		{
+		  locus current_locus = gfc_current_locus;
+		  if (gfc_match ("always ") == MATCH_YES)
+		    {
+		      if (always_modifier++ == 1)
+			second_always_locus = current_locus;
+		    }
+		  else if (gfc_match ("close ") == MATCH_YES)
+		    {
+		      if (close_modifier++ == 1)
+			second_close_locus = current_locus;
+		    }
+		  else
+		    break;
+		  gfc_match (", ");
+		}
+
 	      gfc_omp_map_op map_op = OMP_MAP_TOFROM;
-	      if (gfc_match ("always , ") == MATCH_YES)
-		always = true;
 	      if (gfc_match ("alloc : ") == MATCH_YES)
 		map_op = OMP_MAP_ALLOC;
 	      else if (gfc_match ("tofrom : ") == MATCH_YES)
-		map_op = always ? OMP_MAP_ALWAYS_TOFROM : OMP_MAP_TOFROM;
+		map_op = always_modifier ? OMP_MAP_ALWAYS_TOFROM : OMP_MAP_TOFROM;
 	      else if (gfc_match ("to : ") == MATCH_YES)
-		map_op = always ? OMP_MAP_ALWAYS_TO : OMP_MAP_TO;
+		map_op = always_modifier ? OMP_MAP_ALWAYS_TO : OMP_MAP_TO;
 	      else if (gfc_match ("from : ") == MATCH_YES)
-		map_op = always ? OMP_MAP_ALWAYS_FROM : OMP_MAP_FROM;
+		map_op = always_modifier ? OMP_MAP_ALWAYS_FROM : OMP_MAP_FROM;
 	      else if (gfc_match ("release : ") == MATCH_YES)
 		map_op = OMP_MAP_RELEASE;
 	      else if (gfc_match ("delete : ") == MATCH_YES)
 		map_op = OMP_MAP_DELETE;
-	      else if (always)
+	      else
 		{
 		  gfc_current_locus = old_loc2;
-		  always = false;
+		  always_modifier = 0;
+		  close_modifier = 0;
 		}
+
+	      if (always_modifier > 1)
+		{
+		  gfc_error ("too many %<always%> modifiers at %L",
+			     &second_always_locus);
+		  break;
+		}
+	      if (close_modifier > 1)
+		{
+		  gfc_error ("too many %<close%> modifiers at %L",
+			     &second_close_locus);
+		  break;
+		}
+
 	      head = NULL;
 	      if (gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_MAP],
 					       false, NULL, &head,
@@ -1741,8 +1776,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		    n->u.map_op = map_op;
 		  continue;
 		}
-	      else
-		gfc_current_locus = old_loc;
+	      gfc_current_locus = old_loc;
+	      break;
 	    }
 	  if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable
 	      && gfc_match ("mergeable") == MATCH_YES)
-- 
cgit v1.1


From ea34e2edd3d7ab245d1f57a1487c10587f324ec6 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 21 May 2021 00:16:57 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 4 ++++
 1 file changed, 4 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aa8426f..7fabe76 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,7 @@
+2021-05-20  Marcel Vollweiler  <marcel@codesourcery.com>
+
+	* openmp.c (gfc_match_omp_clauses): Support map-type-modifier 'close'.
+
 2021-05-18  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/100642
-- 
cgit v1.1


From 26ca6dbda23bc6dfab96ce07afa70ebacedfaf9c Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Sat, 22 May 2021 13:27:42 +0200
Subject: Steve Kargl  <kargl@gcc.gnu.org>

PR fortran/98301 - random_init() is broken

Correct implementation of random_init() when -fcoarray=lib is given.

gcc/fortran/ChangeLog:

	PR fortran/98301
	* trans-decl.c (gfc_build_builtin_function_decls): Move decl.
	* trans-intrinsic.c (conv_intrinsic_random_init): Use bool for
	lib-call of caf_random_init instead of logical (4-byte).
	* trans.h: Add tree var for random_init.

libgfortran/ChangeLog:

	PR fortran/98301
	* caf/libcaf.h (_gfortran_caf_random_init): New function.
	* caf/single.c (_gfortran_caf_random_init): New function.
	* gfortran.map: Added fndecl.
	* intrinsics/random_init.f90: Implement random_init.
---
 gcc/fortran/trans-decl.c      |  9 ++++++++-
 gcc/fortran/trans-intrinsic.c | 35 ++++++++++++++++++++---------------
 gcc/fortran/trans.h           |  1 +
 3 files changed, 29 insertions(+), 16 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 406b4ae..c32bd05 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -170,6 +170,7 @@ tree gfor_fndecl_co_min;
 tree gfor_fndecl_co_reduce;
 tree gfor_fndecl_co_sum;
 tree gfor_fndecl_caf_is_present;
+tree gfor_fndecl_caf_random_init;
 
 
 /* Math functions.  Many other math functions are handled in
@@ -233,7 +234,7 @@ tree gfor_fndecl_cgemm;
 tree gfor_fndecl_zgemm;
 
 /* RANDOM_INIT function.  */
-tree gfor_fndecl_random_init;
+tree gfor_fndecl_random_init;      /* libgfortran, 1 image only.  */
 
 static void
 gfc_add_decl_to_parent_function (tree decl)
@@ -3516,6 +3517,8 @@ gfc_build_intrinsic_function_decls (void)
 	void_type_node, 3, gfc_logical4_type_node, gfc_logical4_type_node,
 	gfc_int4_type_node);
 
+ // gfor_fndecl_caf_rand_init is defined in the lib-coarray section below.
+
   gfor_fndecl_sc_kind = gfc_build_library_function_decl_with_spec (
 	get_identifier (PREFIX("selected_char_kind")), ". . R ",
 	gfc_int4_type_node, 2, gfc_charlen_type_node, pchar_type_node);
@@ -4081,6 +4084,10 @@ gfc_build_builtin_function_decls (void)
 	get_identifier (PREFIX("caf_is_present")), ". r . r ",
 	integer_type_node, 3, pvoid_type_node, integer_type_node,
 	pvoid_type_node);
+
+      gfor_fndecl_caf_random_init = gfc_build_library_function_decl (
+	    get_identifier (PREFIX("caf_random_init")),
+	    void_type_node, 2, logical_type_node, logical_type_node);
     }
 
   gfc_build_intrinsic_function_decls ();
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 4d74514..db9248c 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -3827,38 +3827,43 @@ conv_intrinsic_random_init (gfc_code *code)
 {
   stmtblock_t block;
   gfc_se se;
-  tree arg1, arg2, arg3, tmp;
-  tree logical4_type_node = gfc_get_logical_type (4);
+  tree arg1, arg2, tmp;
+  /* On none coarray == lib compiles use LOGICAL(4) else regular LOGICAL.  */
+  tree used_bool_type_node = flag_coarray == GFC_FCOARRAY_LIB
+			     ? logical_type_node
+			     : gfc_get_logical_type (4);
 
   /* Make the function call.  */
   gfc_init_block (&block);
   gfc_init_se (&se, NULL);
 
-  /* Convert REPEATABLE to a LOGICAL(4) entity.  */
+  /* Convert REPEATABLE to the desired LOGICAL entity.  */
   gfc_conv_expr (&se, code->ext.actual->expr);
   gfc_add_block_to_block (&block, &se.pre);
-  arg1 = fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &block));
+  arg1 = fold_convert (used_bool_type_node, gfc_evaluate_now (se.expr, &block));
   gfc_add_block_to_block (&block, &se.post);
 
-  /* Convert IMAGE_DISTINCT to a LOGICAL(4) entity.  */
+  /* Convert IMAGE_DISTINCT to the desired LOGICAL entity.  */
   gfc_conv_expr (&se, code->ext.actual->next->expr);
   gfc_add_block_to_block (&block, &se.pre);
-  arg2 = fold_convert (logical4_type_node, gfc_evaluate_now (se.expr, &block));
+  arg2 = fold_convert (used_bool_type_node, gfc_evaluate_now (se.expr, &block));
   gfc_add_block_to_block (&block, &se.post);
 
-  /* Create the hidden argument.  For non-coarray codes and -fcoarray=single,
-     simply set this to 0.  For -fcoarray=lib, generate a call to
-     THIS_IMAGE() without arguments.  */
-  arg3 = build_int_cst (gfc_get_int_type (4), 0);
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
-      arg3 = build_call_expr_loc (input_location, gfor_fndecl_caf_this_image,
-				  1, arg3);
-      se.expr = fold_convert (gfc_get_int_type (4), arg3);
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_random_init,
+				 2, arg1, arg2);
+    }
+  else
+    {
+      /* The ABI for libgfortran needs to be maintained, so a hidden
+	 argument must be include if code is compiled with -fcoarray=single
+	 or without the option.  Set to 0.  */
+      tree arg3 = build_int_cst (gfc_get_int_type (4), 0);
+      tmp = build_call_expr_loc (input_location, gfor_fndecl_random_init,
+				 3, arg1, arg2, arg3);
     }
 
-  tmp = build_call_expr_loc (input_location, gfor_fndecl_random_init, 3,
-			     arg1, arg2, arg3);
   gfc_add_expr_to_block (&block, tmp);
 
   return gfc_finish_block (&block);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 8c6f82f..69d3fdc 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -969,6 +969,7 @@ extern GTY(()) tree gfor_fndecl_ieee_procedure_exit;
 
 /* RANDOM_INIT.  */
 extern GTY(()) tree gfor_fndecl_random_init;
+extern GTY(()) tree gfor_fndecl_caf_random_init;
 
 /* True if node is an integer constant.  */
 #define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST)
-- 
cgit v1.1


From c4771b3438a8cd9afcef1762957b763f8df3fa6e Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Sat, 22 May 2021 13:36:31 +0200
Subject: PR98301 Add missing changelog entries.

---
 gcc/fortran/ChangeLog | 9 +++++++++
 1 file changed, 9 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7fabe76..2913c18 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2021-05-22  Andre Vehreschild  <vehre@gcc.gnu.org>
+	    Steve Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/98301
+	* trans-decl.c (gfc_build_builtin_function_decls): Move decl.
+	* trans-intrinsic.c (conv_intrinsic_random_init): Use bool for
+	lib-call of caf_random_init instead of logical (4-byte).
+	* trans.h: Add tree var for random_init.
+
 2021-05-20  Marcel Vollweiler  <marcel@codesourcery.com>
 
 	* openmp.c (gfc_match_omp_clauses): Support map-type-modifier 'close'.
-- 
cgit v1.1


From 15d30d2f20794d29ceabcfd57d230d6387284115 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sun, 23 May 2021 00:16:24 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 8 ++++++++
 1 file changed, 8 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2913c18..0b1b13e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,12 @@
 2021-05-22  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/98301
+	* trans-decl.c (gfc_build_builtin_function_decls): Move decl.
+	* trans-intrinsic.c (conv_intrinsic_random_init): Use bool for
+	lib-call of caf_random_init instead of logical (4-byte).
+	* trans.h: Add tree var for random_init.
+
+2021-05-22  Andre Vehreschild  <vehre@gcc.gnu.org>
 	    Steve Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/98301
-- 
cgit v1.1


From 5d3ef9189a7c57679b5fb06e51c90479df0548b0 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Sun, 23 May 2021 11:56:39 +0200
Subject: fortran/intrinsic.texi: Use proper variable name

gcc/fortran/ChangeLog:

	* intrinsic.texi (ATOMIC_ADD, ATOMIC_FETCH_ADD): Use the
	proper variable name in the description.
---
 gcc/fortran/intrinsic.texi | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index a625087..ad16413 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -1870,7 +1870,7 @@ Inverse function: @gol
 
 @table @asis
 @item @emph{Description}:
-@code{ATOMIC_ADD(ATOM, VALUE)} atomically adds the value of @var{VAR} to the
+@code{ATOMIC_ADD(ATOM, VALUE)} atomically adds the value of @var{VALUE} to the
 variable @var{ATOM}. When @var{STAT} is present and the invocation was
 successful, it is assigned the value 0. If it is present and the invocation
 has failed, it is assigned a positive value; in particular, for a coindexed
@@ -2090,7 +2090,7 @@ end program atomic
 @table @asis
 @item @emph{Description}:
 @code{ATOMIC_FETCH_ADD(ATOM, VALUE, OLD)} atomically stores the value of
-@var{ATOM} in @var{OLD} and adds the value of @var{VAR} to the
+@var{ATOM} in @var{OLD} and adds the value of @var{VALUE} to the
 variable @var{ATOM}. When @var{STAT} is present and the invocation was
 successful, it is assigned the value 0. If it is present and the invocation
 has failed, it is assigned a positive value; in particular, for a coindexed
-- 
cgit v1.1


From 6bf8847c732cfcf3094296523940c522253ef068 Mon Sep 17 00:00:00 2001
From: Martin Liska <mliska@suse.cz>
Date: Sun, 23 May 2021 14:08:08 +0200
Subject: Revert "PR98301 Add missing changelog entries."

This reverts commit c4771b3438a8cd9afcef1762957b763f8df3fa6e.
---
 gcc/fortran/ChangeLog | 8 --------
 1 file changed, 8 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0b1b13e..2913c18 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,12 +1,4 @@
 2021-05-22  Andre Vehreschild  <vehre@gcc.gnu.org>
-
-	PR fortran/98301
-	* trans-decl.c (gfc_build_builtin_function_decls): Move decl.
-	* trans-intrinsic.c (conv_intrinsic_random_init): Use bool for
-	lib-call of caf_random_init instead of logical (4-byte).
-	* trans.h: Add tree var for random_init.
-
-2021-05-22  Andre Vehreschild  <vehre@gcc.gnu.org>
 	    Steve Kargl  <kargl@gcc.gnu.org>
 
 	PR fortran/98301
-- 
cgit v1.1


From fe03f4fc9548b3fdbff3c8284a994feaa7d6307d Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 23 May 2021 20:51:14 +0200
Subject: Fortran: fix passing return value to class(*) dummy argument

gcc/fortran/ChangeLog:

	PR fortran/100551
	* trans-expr.c (gfc_conv_procedure_call): Adjust check for
	implicit conversion of actual argument to an unlimited polymorphic
	procedure argument.

gcc/testsuite/ChangeLog:

	PR fortran/100551
	* gfortran.dg/pr100551.f90: New test.
---
 gcc/fortran/trans-expr.c | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cce18d0..3432cd4 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5826,7 +5826,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 				     &derived_array);
 	}
       else if (UNLIMITED_POLY (fsym) && e->ts.type != BT_CLASS
-	       && gfc_expr_attr (e).flavor != FL_PROCEDURE)
+	       && e->ts.type != BT_PROCEDURE
+	       && (gfc_expr_attr (e).flavor != FL_PROCEDURE
+		   || gfc_expr_attr (e).proc != PROC_UNKNOWN))
 	{
 	  /* The intrinsic type needs to be converted to a temporary
 	     CLASS object for the unlimited polymorphic formal.  */
-- 
cgit v1.1


From b94a5024d78fa430a5251fa25ffba51836c83f7c Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Mon, 24 May 2021 00:16:23 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2913c18..5e526916 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2021-05-23  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100551
+	* trans-expr.c (gfc_conv_procedure_call): Adjust check for
+	implicit conversion of actual argument to an unlimited polymorphic
+	procedure argument.
+
+2021-05-23  Tobias Burnus  <tobias@codesourcery.com>
+
+	* intrinsic.texi (ATOMIC_ADD, ATOMIC_FETCH_ADD): Use the
+	proper variable name in the description.
+
 2021-05-22  Andre Vehreschild  <vehre@gcc.gnu.org>
 	    Steve Kargl  <kargl@gcc.gnu.org>
 
-- 
cgit v1.1


From 0e3b3b77e13cac764a135a7118613c47686e0a62 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 24 May 2021 16:50:51 +0200
Subject: OpenMP/Fortran: Handle polymorphic scalars in data-sharing
 FIRSTPRIVATE [PR86470]

gcc/fortran/ChangeLog:

	PR fortran/86470
	* trans-expr.c (gfc_copy_class_to_class): Add unshare_expr.
	* trans-openmp.c (gfc_is_polymorphic_nonptr,
	gfc_is_unlimited_polymorphic_nonptr): New.
	(gfc_omp_clause_copy_ctor, gfc_omp_clause_dtor): Handle
	polymorphic scalars.

libgomp/ChangeLog:

	PR fortran/86470
	* testsuite/libgomp.fortran/class-firstprivate-1.f90: New test.
	* testsuite/libgomp.fortran/class-firstprivate-2.f90: New test.
	* testsuite/libgomp.fortran/class-firstprivate-3.f90: New test.

gcc/testsuite/ChangeLog:

	PR fortran/86470
	* gfortran.dg/gomp/class-firstprivate-1.f90: New test.
	* gfortran.dg/gomp/class-firstprivate-2.f90: New test.
	* gfortran.dg/gomp/class-firstprivate-3.f90: New test.
	* gfortran.dg/gomp/class-firstprivate-4.f90: New test.
---
 gcc/fortran/trans-expr.c   |   2 +-
 gcc/fortran/trans-openmp.c | 162 ++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 162 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 3432cd4..00690fe 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1561,7 +1561,7 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
 	{
 	  vec_safe_push (args, from_len);
 	  vec_safe_push (args, to_len);
-	  extcopy = build_call_vec (fcn_type, fcn, args);
+	  extcopy = build_call_vec (fcn_type, unshare_expr (fcn), args);
 	  tmp = fold_build2_loc (input_location, GT_EXPR,
 				 logical_type_node, from_len,
 				 build_zero_cst (TREE_TYPE (from_len)));
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 5666cd6..44542d9 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -360,6 +360,39 @@ gfc_has_alloc_comps (tree type, tree decl)
   return false;
 }
 
+/* Return true if TYPE is polymorphic but not with pointer attribute.  */
+
+static bool
+gfc_is_polymorphic_nonptr (tree type)
+{
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  return GFC_CLASS_TYPE_P (type);
+}
+
+/* Return true if TYPE is unlimited polymorphic but not with pointer attribute;
+   unlimited means also intrinsic types are handled and _len is used.  */
+
+static bool
+gfc_is_unlimited_polymorphic_nonptr (tree type)
+{
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+  if (!GFC_CLASS_TYPE_P (type))
+    return false;
+
+  tree field = TYPE_FIELDS (type); /* _data */
+  gcc_assert (field);
+  field = DECL_CHAIN (field); /* _vptr */
+  gcc_assert (field);
+  field = DECL_CHAIN (field);
+  if (!field)
+    return false;
+  gcc_assert (strcmp ("_len", IDENTIFIER_POINTER (DECL_NAME (field))) == 0);
+  return true;
+}
+
+
 /* Return true if DECL in private clause needs
    OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause.  */
 bool
@@ -743,12 +776,88 @@ tree
 gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 {
   tree type = TREE_TYPE (dest), ptr, size, call;
+  tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
   tree cond, then_b, else_b;
   stmtblock_t block, cond_block;
 
   gcc_assert (OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_FIRSTPRIVATE
 	      || OMP_CLAUSE_CODE (clause) == OMP_CLAUSE_LINEAR);
 
+  if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
+      && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
+      && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
+    decl_type
+      = TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
+
+  if (gfc_is_polymorphic_nonptr (decl_type))
+    {
+      if (POINTER_TYPE_P (decl_type))
+	decl_type = TREE_TYPE (decl_type);
+      decl_type = TREE_TYPE (TYPE_FIELDS (decl_type));
+      if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type))
+	fatal_error (input_location,
+		     "Sorry, polymorphic arrays not yet supported for "
+		     "firstprivate");
+      tree src_len;
+      tree nelems = build_int_cst (size_type_node, 1);  /* Scalar.  */
+      tree src_data = gfc_class_data_get (unshare_expr (src));
+      tree dest_data = gfc_class_data_get (unshare_expr (dest));
+      bool unlimited = gfc_is_unlimited_polymorphic_nonptr (type);
+
+      gfc_start_block (&block);
+      gfc_add_modify (&block, gfc_class_vptr_get (dest),
+		      gfc_class_vptr_get (src));
+      gfc_init_block (&cond_block);
+
+      if (unlimited)
+	{
+	  src_len = gfc_class_len_get (src);
+	  gfc_add_modify (&cond_block, gfc_class_len_get (unshare_expr (dest)), src_len);
+	}
+
+      /* Use: size = class._vtab._size * (class._len > 0 ? class._len : 1).  */
+      size = fold_convert (size_type_node, gfc_class_vtab_size_get (src));
+      if (unlimited)
+	{
+	  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+				  unshare_expr (src_len),
+				  build_zero_cst (TREE_TYPE (src_len)));
+	  cond = build3_loc (input_location, COND_EXPR, size_type_node, cond,
+			     fold_convert (size_type_node,
+					   unshare_expr (src_len)),
+			     build_int_cst (size_type_node, 1));
+	  size = fold_build2_loc (input_location, MULT_EXPR, size_type_node,
+				  size, cond);
+	}
+
+      /* Malloc memory + call class->_vpt->_copy.  */
+      call = builtin_decl_explicit (BUILT_IN_MALLOC);
+      call = build_call_expr_loc (input_location, call, 1, size);
+      gfc_add_modify (&cond_block, dest_data,
+		      fold_convert (TREE_TYPE (dest_data), call));
+      gfc_add_expr_to_block (&cond_block,
+			     gfc_copy_class_to_class (src, dest, nelems,
+						      unlimited));
+
+      gcc_assert (TREE_CODE (dest_data) == COMPONENT_REF);
+      if (!GFC_DECL_GET_SCALAR_ALLOCATABLE (TREE_OPERAND (dest_data, 1)))
+	{
+	  gfc_add_block_to_block (&block, &cond_block);
+	}
+      else
+	{
+	  /* Create: if (class._data != 0) <cond_block> else class._data = NULL; */
+	  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				  src_data, null_pointer_node);
+	  gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
+				 void_type_node, cond,
+				 gfc_finish_block (&cond_block),
+				 fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
+				 unshare_expr (dest_data), null_pointer_node)));
+	}
+      return gfc_finish_block (&block);
+    }
+
   if ((! GFC_DESCRIPTOR_TYPE_P (type)
        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
       && (!GFC_DECL_GET_SCALAR_ALLOCATABLE (OMP_CLAUSE_DECL (clause))
@@ -773,7 +882,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 
   gfc_init_block (&cond_block);
 
-  gfc_add_modify (&cond_block, dest, src);
+  gfc_add_modify (&cond_block, dest, fold_convert (TREE_TYPE (dest), src));
   if (GFC_DESCRIPTOR_TYPE_P (type))
     {
       tree rank = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (type) - 1];
@@ -1185,6 +1294,57 @@ tree
 gfc_omp_clause_dtor (tree clause, tree decl)
 {
   tree type = TREE_TYPE (decl), tem;
+  tree decl_type = TREE_TYPE (OMP_CLAUSE_DECL (clause));
+
+  if (DECL_ARTIFICIAL (OMP_CLAUSE_DECL (clause))
+      && DECL_LANG_SPECIFIC (OMP_CLAUSE_DECL (clause))
+      && GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)))
+    decl_type
+	= TREE_TYPE (GFC_DECL_SAVED_DESCRIPTOR (OMP_CLAUSE_DECL (clause)));
+  if (gfc_is_polymorphic_nonptr (decl_type))
+    {
+      if (POINTER_TYPE_P (decl_type))
+	decl_type = TREE_TYPE (decl_type);
+      decl_type = TREE_TYPE (TYPE_FIELDS (decl_type));
+      if (GFC_DESCRIPTOR_TYPE_P (decl_type) || GFC_ARRAY_TYPE_P (decl_type))
+	fatal_error (input_location,
+		     "Sorry, polymorphic arrays not yet supported for "
+		     "firstprivate");
+      stmtblock_t block, cond_block;
+      gfc_start_block (&block);
+      gfc_init_block (&cond_block);
+      tree final = gfc_class_vtab_final_get (decl);
+      tree size = fold_convert (size_type_node, gfc_class_vtab_size_get (decl));
+      gfc_se se;
+      gfc_init_se (&se, NULL);
+      symbol_attribute attr = {};
+      tree data = gfc_class_data_get (decl);
+      tree desc = gfc_conv_scalar_to_descriptor (&se, data, attr);
+
+      /* Call class->_vpt->_finalize + free.  */
+      tree call = build_fold_indirect_ref (final);
+      call = build_call_expr_loc (input_location, call, 3,
+				  gfc_build_addr_expr (NULL, desc),
+				  size, boolean_false_node);
+      gfc_add_block_to_block (&cond_block, &se.pre);
+      gfc_add_expr_to_block (&cond_block, fold_convert (void_type_node, call));
+      gfc_add_block_to_block (&cond_block, &se.post);
+      /* Create: if (_vtab && _final) <cond_block>  */
+      tree cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				   gfc_class_vptr_get (decl),
+				   null_pointer_node);
+      tree cond2 = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				   final, null_pointer_node);
+      cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+			      boolean_type_node, cond, cond2);
+      gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
+				 void_type_node, cond,
+				 gfc_finish_block (&cond_block), NULL_TREE));
+      call = builtin_decl_explicit (BUILT_IN_FREE);
+      call = build_call_expr_loc (input_location, call, 1, data);
+      gfc_add_expr_to_block (&block, fold_convert (void_type_node, call));
+      return gfc_finish_block (&block);
+    }
 
   if ((! GFC_DESCRIPTOR_TYPE_P (type)
        || GFC_TYPE_ARRAY_AKIND (type) != GFC_ARRAY_ALLOCATABLE)
-- 
cgit v1.1


From 637569df03507cfd603d0979652b0a936d9b122d Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 25 May 2021 00:16:53 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 9 +++++++++
 1 file changed, 9 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5e526916..e614039 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2021-05-24  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/86470
+	* trans-expr.c (gfc_copy_class_to_class): Add unshare_expr.
+	* trans-openmp.c (gfc_is_polymorphic_nonptr,
+	gfc_is_unlimited_polymorphic_nonptr): New.
+	(gfc_omp_clause_copy_ctor, gfc_omp_clause_dtor): Handle
+	polymorphic scalars.
+
 2021-05-23  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/100551
-- 
cgit v1.1


From d8f6ceb58e6f506866cf0eacd2874f30743ea47c Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 25 May 2021 09:17:07 +0200
Subject: fortran/intrinsic.texi: Fix copy'n'paste errors and typos

gcc/fortran/ChangeLog:

	* intrinsic.texi (GERROR, GETARGS, GETLOG, NORM2, PARITY, RANDOM_INIT,
	RANDOM_NUMBER): Fix typos and copy'n'paste errors.

Co-Authored-By: Johannes Nendwich <a08727063@unet.univie.ac.at>
---
 gcc/fortran/intrinsic.texi | 13 ++++++-------
 1 file changed, 6 insertions(+), 7 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index ad16413..c9049b53 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -6835,7 +6835,7 @@ Subroutine
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{RESULT}  @tab Shall of type @code{CHARACTER} and of default
+@item @var{RESULT}  @tab Shall be of type @code{CHARACTER} and of default kind.
 @end multitable
 
 @item @emph{Example}:
@@ -6885,7 +6885,6 @@ Subroutine
 the default integer kind; @math{@var{POS} \geq 0}
 @item @var{VALUE} @tab Shall be of type @code{CHARACTER} and of default
 kind.
-@item @var{VALUE} @tab Shall be of type @code{CHARACTER}. 
 @end multitable
 
 @item @emph{Return value}:
@@ -7259,7 +7258,7 @@ Subroutine
 @end multitable
 
 @item @emph{Return value}:
-Stores the current user name in @var{LOGIN}.  (On systems where POSIX
+Stores the current user name in @var{C}.  (On systems where POSIX
 functions @code{geteuid} and @code{getpwuid} are not available, and 
 the @code{getlogin} function is not implemented either, this will
 return a blank string.)
@@ -11202,7 +11201,7 @@ end program test_nint
 
 @table @asis
 @item @emph{Description}:
-Calculates the Euclidean vector norm (@math{L_2} norm) of
+Calculates the Euclidean vector norm (@math{L_2} norm)
 of @var{ARRAY} along dimension @var{DIM}.
 
 @item @emph{Standard}:
@@ -11555,7 +11554,7 @@ Transformational function
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-@item @var{LOGICAL} @tab Shall be an array of type @code{LOGICAL}
+@item @var{MASK} @tab Shall be an array of type @code{LOGICAL}
 @item @var{DIM}   @tab (Optional) shall be a scalar of type 
 @code{INTEGER} with a value in the range from 1 to n, where n 
 equals the rank of @var{MASK}.
@@ -12005,7 +12004,7 @@ is set to a processor-dependent value.
 @code{LOGICAL} type, and it is @code{INTENT(IN)}.  If it is @code{.true.},
 the seed is set to a processor-dependent value that is distinct from th
 seed set by a call to @code{RANDOM_INIT} in another image.  If it is
-@code{.false.}, the seed is set value that does depend which image called
+@code{.false.}, the seed is set to a value that does depend which image called
 @code{RANDOM_INIT}.
 @end multitable
 
@@ -12057,7 +12056,7 @@ Fortran 90 and later
 Subroutine
 
 @item @emph{Syntax}:
-@code{RANDOM_NUMBER(HARVEST)}
+@code{CALL RANDOM_NUMBER(HARVEST)}
 
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
-- 
cgit v1.1


From 2bc6dacecb2ba60f1f06f310c6887a26b09cdba8 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 26 May 2021 00:16:41 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e614039..b30db1c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-05-25  Tobias Burnus  <tobias@codesourcery.com>
+	    Johannes Nendwich  <a08727063@unet.univie.ac.at>
+
+	* intrinsic.texi (GERROR, GETARGS, GETLOG, NORM2, PARITY, RANDOM_INIT,
+	RANDOM_NUMBER): Fix typos and copy'n'paste errors.
+
 2021-05-24  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/86470
-- 
cgit v1.1


From 9d3a953ec4d2695e9a6bfa5f22655e2aea47a973 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 27 May 2021 13:55:11 +0200
Subject: PR fortran/100656 - prevent ICE in gfc_conv_expr_present

gcc/fortran/ChangeLog:

	PR fortran/100656
	* trans-array.c (gfc_conv_ss_startstride): Do not call check for
	presence of a dummy argument when a symbol actually refers to a
	non-dummy.

gcc/testsuite/ChangeLog:

	PR fortran/100656
	* gfortran.dg/bounds_check_22.f90: New test.
---
 gcc/fortran/trans-array.c | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6d38ea7..7eeef55 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4718,8 +4718,9 @@ done:
 
 	  /* For optional arguments, only check bounds if the argument is
 	     present.  */
-	  if (expr->symtree->n.sym->attr.optional
-	      || expr->symtree->n.sym->attr.not_always_present)
+	  if ((expr->symtree->n.sym->attr.optional
+	       || expr->symtree->n.sym->attr.not_always_present)
+	      && expr->symtree->n.sym->attr.dummy)
 	    tmp = build3_v (COND_EXPR,
 			    gfc_conv_expr_present (expr->symtree->n.sym),
 			    tmp, build_empty_stmt (input_location));
-- 
cgit v1.1


From 71d7dc6cd09b603bcc58d5d1747a86eb498bb147 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 27 May 2021 13:58:26 +0200
Subject: Fortran: Fix erroneous "pointer argument is not associated" runtime
 error

For CLASS arrays we need to use the CLASS data attributes to determine
which runtime check to generate.

gcc/fortran/ChangeLog:

	PR fortran/100602
	* trans-intrinsic.c (gfc_conv_intrinsic_size): Use CLASS data
	attributes for CLASS arrays for generation of runtime error.

gcc/testsuite/ChangeLog:

	PR fortran/100602
	* gfortran.dg/pointer_check_14.f90: New test.
---
 gcc/fortran/trans-intrinsic.c | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index db9248c..98fa28d 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -8004,7 +8004,14 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr)
       tree temp;
       tree cond;
 
-      attr = sym ? sym->attr : gfc_expr_attr (e);
+      if (e->symtree->n.sym && IS_CLASS_ARRAY (e->symtree->n.sym))
+	{
+	  attr = CLASS_DATA (e->symtree->n.sym)->attr;
+	  attr.pointer = attr.class_pointer;
+	}
+      else
+	attr = gfc_expr_attr (e);
+
       if (attr.allocatable)
 	msg = xasprintf ("Allocatable argument '%s' is not allocated",
 			 e->symtree->n.sym->name);
-- 
cgit v1.1


From cd62d089f6021fd1ad4537b8182836d15b14514f Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 28 May 2021 00:16:38 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b30db1c..d261101 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2021-05-27  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100602
+	* trans-intrinsic.c (gfc_conv_intrinsic_size): Use CLASS data
+	attributes for CLASS arrays for generation of runtime error.
+
+2021-05-27  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100656
+	* trans-array.c (gfc_conv_ss_startstride): Do not call check for
+	presence of a dummy argument when a symbol actually refers to a
+	non-dummy.
+
 2021-05-25  Tobias Burnus  <tobias@codesourcery.com>
 	    Johannes Nendwich  <a08727063@unet.univie.ac.at>
 
-- 
cgit v1.1


From 9a5de4d5af1c10a8c097de30ee4c71457216e975 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 28 May 2021 10:01:19 +0200
Subject: OpenMP: Add iterator support to Fortran's depend; add affinity clause

gcc/c-family/ChangeLog:

	* c-pragma.h (enum pragma_omp_clause): Add PRAGMA_OMP_CLAUSE_AFFINITY.

gcc/c/ChangeLog:

	* c-parser.c (c_parser_omp_clause_affinity): New.
	(c_parser_omp_clause_name, c_parser_omp_variable_list,
	c_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity clause.
	* c-typeck.c (handle_omp_array_sections_1, handle_omp_array_sections,
	c_finish_omp_clauses): Likewise.

gcc/cp/ChangeLog:

	* parser.c (cp_parser_omp_clause_affinity): New.
	(cp_parser_omp_clause_name, cp_parser_omp_var_list_no_open,
	cp_parser_omp_all_clauses, OMP_TASK_CLAUSE_MASK): Handle affinity
	clause.
	* semantics.c (handle_omp_array_sections_1, handle_omp_array_sections,
	finish_omp_clauses): Likewise.

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_iterator): New.
	(show_omp_namelist): Handle iterators.
	(show_omp_clauses): Handle affinity.
	* gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'.
	* match.c (gfc_free_omp_namelist): Add are to choose union element.
	* openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach,
	gfc_match_omp_clause_reduction, gfc_match_omp_flush): Update
	call to gfc_free_omp_namelist.
	(gfc_match_omp_variable_list): Likewise; permit preceeding whitespace.
	(enum omp_mask1): Add OMP_CLAUSE_AFFINITY.
	(gfc_match_iterator): New.
	(gfc_match_omp_clauses): Use it; update call to gfc_free_omp_namelist.
	(OMP_TASK_CLAUSES): Add OMP_CLAUSE_AFFINITY.
	(gfc_match_omp_taskwait): Match depend clause.
	(resolve_omp_clauses): Handle affinity; update for udr/union change.
	(gfc_resolve_omp_directive): Resolve clauses of taskwait.
	* st.c (gfc_free_statement): Update gfc_free_omp_namelist call.
	* trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise
	(handle_iterator): New.
	(gfc_trans_omp_clauses): Handle iterators for depend/affinity clause.
	(gfc_trans_omp_taskwait): Handle depend clause.
	(gfc_trans_omp_directive): Update call.

gcc/ChangeLog:

	* gimplify.c (gimplify_omp_affinity): New.
	(gimplify_scan_omp_clauses): Call it; remove affinity clause afterwards.
	* tree-core.h (enum omp_clause_code): Add OMP_CLAUSE_AFFINITY.
	* tree-pretty-print.c (dump_omp_clause): Handle OMP_CLAUSE_AFFINITY.
	* tree.c (omp_clause_num_ops, omp_clause_code_name): Add clause.
	(walk_tree_1): Handle OMP_CLAUSE_AFFINITY.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/depend-iterator-2.f90: New test.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/affinity-1.c: New test.
	* c-c++-common/gomp/affinity-2.c: New test.
	* c-c++-common/gomp/affinity-3.c: New test.
	* c-c++-common/gomp/affinity-4.c: New test.
	* c-c++-common/gomp/affinity-5.c: New test.
	* c-c++-common/gomp/affinity-6.c: New test.
	* c-c++-common/gomp/affinity-7.c: New test.
	* gfortran.dg/gomp/affinity-clause-1.f90: New test.
	* gfortran.dg/gomp/affinity-clause-2.f90: New test.
	* gfortran.dg/gomp/affinity-clause-3.f90: New test.
	* gfortran.dg/gomp/affinity-clause-4.f90: New test.
	* gfortran.dg/gomp/affinity-clause-5.f90: New test.
	* gfortran.dg/gomp/affinity-clause-6.f90: New test.
	* gfortran.dg/gomp/depend-iterator-1.f90: New test.
	* gfortran.dg/gomp/depend-iterator-2.f90: New test.
	* gfortran.dg/gomp/depend-iterator-3.f90: New test.
	* gfortran.dg/gomp/taskwait.f90: New test.
---
 gcc/fortran/dump-parse-tree.c |  51 ++++++-
 gcc/fortran/gfortran.h        |   9 +-
 gcc/fortran/match.c           |  18 +--
 gcc/fortran/openmp.c          | 307 ++++++++++++++++++++++++++++++++++++------
 gcc/fortran/st.c              |   2 +-
 gcc/fortran/trans-openmp.c    | 198 +++++++++++++++++++++------
 6 files changed, 491 insertions(+), 94 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 874e6d4..93ff572 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1298,10 +1298,55 @@ show_code (int level, gfc_code *c)
 }
 
 static void
+show_iterator (gfc_namespace *ns)
+{
+  for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
+    {
+      gfc_constructor *c;
+      if (sym != ns->proc_name)
+	fputc (',', dumpfile);
+      fputs (sym->name, dumpfile);
+      fputc ('=', dumpfile);
+      c = gfc_constructor_first (sym->value->value.constructor);
+      show_expr (c->expr);
+      fputc (':', dumpfile);
+      c = gfc_constructor_next (c);
+      show_expr (c->expr);
+      c = gfc_constructor_next (c);
+      if (c)
+	{
+	  fputc (':', dumpfile);
+	  show_expr (c->expr);
+	}
+    }
+}
+
+static void
 show_omp_namelist (int list_type, gfc_omp_namelist *n)
 {
+  gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+  gfc_omp_namelist *n2 = n;
   for (; n; n = n->next)
     {
+      gfc_current_ns = ns_curr;
+      if (list_type == OMP_LIST_AFFINITY || list_type == OMP_LIST_DEPEND)
+	{
+	  gfc_current_ns = n->u2.ns ? n->u2.ns : ns_curr;
+	  if (n->u2.ns != ns_iter)
+	    {
+	      if (n != n2)
+		fputs (list_type == OMP_LIST_AFFINITY
+		       ? ") AFFINITY(" : ") DEPEND(", dumpfile);
+	      if (n->u2.ns)
+		{
+		  fputs ("ITERATOR(", dumpfile);
+		  show_iterator (n->u2.ns);
+		  fputc (')', dumpfile);
+		  fputc (list_type == OMP_LIST_AFFINITY ? ':' : ',', dumpfile);
+		}
+	    }
+	  ns_iter = n->u2.ns;
+	}
       if (list_type == OMP_LIST_REDUCTION)
 	switch (n->u.reduction_op)
 	  {
@@ -1321,8 +1366,8 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
 	  case OMP_REDUCTION_IOR: fputs ("ior:", dumpfile); break;
 	  case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break;
 	  case OMP_REDUCTION_USER:
-	    if (n->udr)
-	      fprintf (dumpfile, "%s:", n->udr->udr->name);
+	    if (n->u2.udr)
+	      fprintf (dumpfile, "%s:", n->u2.udr->udr->name);
 	    break;
 	  default: break;
 	  }
@@ -1387,6 +1432,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
       if (n->next)
 	fputc (',', dumpfile);
     }
+  gfc_current_ns = ns_curr;
 }
 
 
@@ -1610,6 +1656,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
 	  case OMP_LIST_SHARED: type = "SHARED"; break;
 	  case OMP_LIST_COPYIN: type = "COPYIN"; break;
 	  case OMP_LIST_UNIFORM: type = "UNIFORM"; break;
+	  case OMP_LIST_AFFINITY: type = "AFFINITY"; break;
 	  case OMP_LIST_ALIGNED: type = "ALIGNED"; break;
 	  case OMP_LIST_LINEAR: type = "LINEAR"; break;
 	  case OMP_LIST_DEPEND: type = "DEPEND"; break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bab785b..55fba04 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1257,7 +1257,11 @@ typedef struct gfc_omp_namelist
       struct gfc_common_head *common;
       bool lastprivate_conditional;
     } u;
-  struct gfc_omp_namelist_udr *udr;
+  union
+    {
+      struct gfc_omp_namelist_udr *udr;
+      gfc_namespace *ns;
+    } u2;
   struct gfc_omp_namelist *next;
   locus where;
 }
@@ -1275,6 +1279,7 @@ enum
   OMP_LIST_SHARED,
   OMP_LIST_COPYIN,
   OMP_LIST_UNIFORM,
+  OMP_LIST_AFFINITY,
   OMP_LIST_ALIGNED,
   OMP_LIST_LINEAR,
   OMP_LIST_DEPEND,
@@ -3321,7 +3326,7 @@ void gfc_free_iterator (gfc_iterator *, int);
 void gfc_free_forall_iterator (gfc_forall_iterator *);
 void gfc_free_alloc_list (gfc_alloc *);
 void gfc_free_namelist (gfc_namelist *);
-void gfc_free_omp_namelist (gfc_omp_namelist *);
+void gfc_free_omp_namelist (gfc_omp_namelist *, bool);
 void gfc_free_equiv (gfc_equiv *);
 void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
 void gfc_free_data (gfc_data *);
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 393755e..2946201 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5470,20 +5470,22 @@ gfc_free_namelist (gfc_namelist *name)
 /* Free an OpenMP namelist structure.  */
 
 void
-gfc_free_omp_namelist (gfc_omp_namelist *name)
+gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns)
 {
   gfc_omp_namelist *n;
 
   for (; name; name = n)
     {
       gfc_free_expr (name->expr);
-      if (name->udr)
-	{
-	  if (name->udr->combiner)
-	    gfc_free_statement (name->udr->combiner);
-	  if (name->udr->initializer)
-	    gfc_free_statement (name->udr->initializer);
-	  free (name->udr);
+      if (free_ns)
+	gfc_free_namespace (name->u2.ns);
+      else if (name->u2.udr)
+	{
+	  if (name->u2.udr->combiner)
+	    gfc_free_statement (name->u2.udr->combiner);
+	  if (name->u2.udr->initializer)
+	    gfc_free_statement (name->u2.udr->initializer);
+	  free (name->u2.udr);
 	}
       n = name->next;
       free (name);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index cf4d7ba..4ed6a0d 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "arith.h"
 #include "match.h"
 #include "parse.h"
+#include "constructor.h"
 #include "diagnostic.h"
 #include "gomp-constants.h"
 
@@ -103,7 +104,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
   gfc_free_expr (c->num_workers_expr);
   gfc_free_expr (c->vector_length_expr);
   for (i = 0; i < OMP_LIST_NUM; i++)
-    gfc_free_omp_namelist (c->lists[i]);
+    gfc_free_omp_namelist (c->lists[i],
+			   i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND);
   gfc_free_expr_list (c->wait_list);
   gfc_free_expr_list (c->tile_list);
   free (CONST_CAST (char *, c->critical_name));
@@ -355,7 +357,7 @@ syntax:
   gfc_error ("Syntax error in OpenMP variable list at %C");
 
 cleanup:
-  gfc_free_omp_namelist (head);
+  gfc_free_omp_namelist (head, false);
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
 }
@@ -445,7 +447,7 @@ syntax:
   gfc_error ("Syntax error in OpenMP variable list at %C");
 
 cleanup:
-  gfc_free_omp_namelist (head);
+  gfc_free_omp_namelist (head, false);
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
 }
@@ -552,7 +554,7 @@ syntax:
   gfc_error ("Syntax error in OpenMP DEPEND SINK list at %C");
 
 cleanup:
-  gfc_free_omp_namelist (head);
+  gfc_free_omp_namelist (head, false);
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
 }
@@ -843,6 +845,7 @@ enum omp_mask1
   OMP_CLAUSE_CAPTURE,  /* OpenMP 5.0.  */
   OMP_CLAUSE_MEMORDER,  /* OpenMP 5.0.  */
   OMP_CLAUSE_DETACH,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_AFFINITY,  /* OpenMP 5.0.  */
   OMP_CLAUSE_NOWAIT,
   /* This must come last.  */
   OMP_MASK1_LAST
@@ -996,6 +999,132 @@ gfc_match_omp_map_clause (gfc_omp_namelist **list, gfc_omp_map_op map_op,
   return false;
 }
 
+static match
+gfc_match_iterator (gfc_namespace **ns, bool permit_var)
+{
+  locus old_loc = gfc_current_locus;
+
+  if (gfc_match ("iterator ( ") != MATCH_YES)
+    return MATCH_NO;
+
+  gfc_typespec ts;
+  gfc_symbol *last = NULL;
+  gfc_expr *begin, *end, *step;
+  *ns = gfc_build_block_ns (gfc_current_ns);
+  char name[GFC_MAX_SYMBOL_LEN + 1];
+  while (true)
+    {
+      locus prev_loc = gfc_current_locus;
+      if (gfc_match_type_spec (&ts) == MATCH_YES
+	  && gfc_match (" :: ") == MATCH_YES)
+	{
+	  if (ts.type != BT_INTEGER)
+	    {
+	      gfc_error ("Expected INTEGER type at %L", &prev_loc);
+	      return MATCH_ERROR;
+	    }
+	  permit_var = false;
+	}
+      else
+	{
+	  ts.type = BT_INTEGER;
+	  ts.kind = gfc_default_integer_kind;
+	  gfc_current_locus = prev_loc;
+	}
+      prev_loc = gfc_current_locus;
+      if (gfc_match_name (name) != MATCH_YES)
+	{
+	  gfc_error ("Expected identifier at %C");
+	  goto failed;
+	}
+      if (gfc_find_symtree ((*ns)->sym_root, name))
+	{
+	  gfc_error ("Same identifier %qs specified again at %C", name);
+	  goto failed;
+	}
+
+      gfc_symbol *sym = gfc_new_symbol (name, *ns);
+      if (last)
+	last->tlink = sym;
+      else
+	(*ns)->proc_name = sym;
+      last = sym;
+      sym->declared_at = prev_loc;
+      sym->ts = ts;
+      sym->attr.flavor = FL_VARIABLE;
+      sym->attr.artificial = 1;
+      sym->attr.referenced = 1;
+      sym->refs++;
+      gfc_symtree *st = gfc_new_symtree (&(*ns)->sym_root, name);
+      st->n.sym = sym;
+
+      prev_loc = gfc_current_locus;
+      if (gfc_match (" = ") != MATCH_YES)
+	goto failed;
+      permit_var = false;
+      begin = end = step = NULL;
+      if (gfc_match ("%e : ", &begin) != MATCH_YES
+	  || gfc_match ("%e ", &end) != MATCH_YES)
+	{
+	  gfc_error ("Expected range-specification at %C");
+	  gfc_free_expr (begin);
+	  gfc_free_expr (end);
+	  return MATCH_ERROR;
+	}
+      if (':' == gfc_peek_ascii_char ())
+	{
+	  step = gfc_get_expr ();
+	  if (gfc_match (": %e ", &step) != MATCH_YES)
+	    {
+	      gfc_free_expr (begin);
+	      gfc_free_expr (end);
+	      gfc_free_expr (step);
+	      goto failed;
+	    }
+	}
+
+      gfc_expr *e = gfc_get_expr ();
+      e->where = prev_loc;
+      e->expr_type = EXPR_ARRAY;
+      e->ts = ts;
+      e->rank = 1;
+      e->shape = gfc_get_shape (1);
+      mpz_init_set_ui (e->shape[0], step ? 3 : 2);
+      gfc_constructor_append_expr (&e->value.constructor, begin, &begin->where);
+      gfc_constructor_append_expr (&e->value.constructor, end, &end->where);
+      if (step)
+	gfc_constructor_append_expr (&e->value.constructor, step, &step->where);
+      sym->value = e;
+
+      if (gfc_match (") ") == MATCH_YES)
+	break;
+      if (gfc_match (", ") != MATCH_YES)
+	goto failed;
+    }
+  return MATCH_YES;
+
+failed:
+  gfc_namespace *prev_ns = NULL;
+  for (gfc_namespace *it = gfc_current_ns->contained; it; it = it->sibling)
+    {
+      if (it == *ns)
+	{
+	  if (prev_ns)
+	    prev_ns->sibling = it->sibling;
+	  else
+	    gfc_current_ns->contained = it->sibling;
+	  gfc_free_namespace (it);
+	  break;
+	}
+      prev_ns = it;
+    }
+  *ns = NULL;
+  if (!permit_var)
+    return MATCH_ERROR;
+  gfc_current_locus = old_loc;
+  return MATCH_NO;
+}
+
 /* reduction ( reduction-modifier, reduction-operator : variable-list )
    in_reduction ( reduction-operator : variable-list )
    task_reduction ( reduction-operator : variable-list )  */
@@ -1138,7 +1267,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
       *head = NULL;
       gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
 		     buffer, &old_loc);
-      gfc_free_omp_namelist (n);
+      gfc_free_omp_namelist (n, false);
     }
   else
     for (n = *head; n; n = n->next)
@@ -1146,8 +1275,8 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
 	n->u.reduction_op = rop;
 	if (udr)
 	  {
-	    n->udr = gfc_get_omp_namelist_udr ();
-	    n->udr->udr = udr;
+	    n->u2.udr = gfc_get_omp_namelist_udr ();
+	    n->u2.udr->udr = udr;
 	  }
      }
   return MATCH_YES;
@@ -1202,7 +1331,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 
 	      if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
 		{
-		  gfc_free_omp_namelist (*head);
+		  gfc_free_omp_namelist (*head, false);
 		  gfc_current_locus = old_loc;
 		  *head = NULL;
 		  break;
@@ -1230,6 +1359,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      needs_space = true;
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_AFFINITY)
+	      && gfc_match ("affinity ( ") == MATCH_YES)
+	    {
+	      gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+	      match m = gfc_match_iterator (&ns_iter, true);
+	      if (m == MATCH_ERROR)
+		break;
+	      if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
+		{
+		  gfc_error ("Expected %<:%> at %C");
+		  break;
+		}
+	      if (ns_iter)
+		gfc_current_ns = ns_iter;
+	      head = NULL;
+	      m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_AFFINITY],
+					       false, NULL, &head, true);
+	      gfc_current_ns = ns_curr;
+	      if (m == MATCH_ERROR)
+		break;
+	      if (ns_iter)
+		{
+		  for (gfc_omp_namelist *n = *head; n; n = n->next)
+		    {
+		      n->u2.ns = ns_iter;
+		      ns_iter->refs++;
+		    }
+		}
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_ASYNC)
 	      && !c->async
 	      && gfc_match ("async") == MATCH_YES)
@@ -1374,6 +1533,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_DEPEND)
 	      && gfc_match ("depend ( ") == MATCH_YES)
 	    {
+	      gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
+	      match m_it = gfc_match_iterator (&ns_iter, false);
+	      if (m_it == MATCH_ERROR)
+		break;
+	      if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES)
+		break;
 	      match m = MATCH_YES;
 	      gfc_omp_depend_op depend_op = OMP_DEPEND_OUT;
 	      if (gfc_match ("inout") == MATCH_YES)
@@ -1389,11 +1554,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      else if (!c->depend_source
 		       && gfc_match ("source )") == MATCH_YES)
 		{
+		  if (m_it == MATCH_YES)
+		    {
+		      gfc_error ("ITERATOR may not be combined with SOURCE "
+				 "at %C");
+		      gfc_free_omp_clauses (c);
+		      return MATCH_ERROR;
+		    }
 		  c->depend_source = true;
 		  continue;
 		}
 	      else if (gfc_match ("sink : ") == MATCH_YES)
 		{
+		  if (m_it == MATCH_YES)
+		    {
+		      gfc_error ("ITERATOR may not be combined with SINK "
+				 "at %C");
+		      break;
+		    }
 		  if (gfc_match_omp_depend_sink (&c->lists[OMP_LIST_DEPEND])
 		      == MATCH_YES)
 		    continue;
@@ -1402,19 +1580,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      else
 		m = MATCH_NO;
 	      head = NULL;
-	      if (m == MATCH_YES
-		  && gfc_match_omp_variable_list (" : ",
-						  &c->lists[OMP_LIST_DEPEND],
-						  false, NULL, &head,
-						  true) == MATCH_YES)
+	      if (ns_iter)
+		gfc_current_ns = ns_iter;
+	      if (m == MATCH_YES)
+		m = gfc_match_omp_variable_list (" : ",
+						 &c->lists[OMP_LIST_DEPEND],
+						 false, NULL, &head, true);
+	      gfc_current_ns = ns_curr;
+	      if (m == MATCH_YES)
 		{
 		  gfc_omp_namelist *n;
 		  for (n = *head; n; n = n->next)
-		    n->u.depend_op = depend_op;
+		    {
+		      n->u.depend_op = depend_op;
+		      n->u2.ns = ns_iter;
+		      if (ns_iter)
+			ns_iter->refs++;
+		    }
 		  continue;
 		}
-	      else
-		gfc_current_locus = old_loc;
+	      break;
 	    }
 	  if ((mask & OMP_CLAUSE_DETACH)
 	      && !openacc
@@ -1666,7 +1851,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		    end_colon = true;
 		  else if (gfc_match (" )") != MATCH_YES)
 		    {
-		      gfc_free_omp_namelist (*head);
+		      gfc_free_omp_namelist (*head, false);
 		      gfc_current_locus = old_loc;
 		      *head = NULL;
 		      break;
@@ -1674,7 +1859,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		}
 	      if (end_colon && gfc_match (" %e )", &step) != MATCH_YES)
 		{
-		  gfc_free_omp_namelist (*head);
+		  gfc_free_omp_namelist (*head, false);
 		  gfc_current_locus = old_loc;
 		  *head = NULL;
 		  break;
@@ -2844,7 +3029,7 @@ cleanup:
    | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT		\
    | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE	\
    | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION	\
-   | OMP_CLAUSE_DETACH)
+   | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY)
 #define OMP_TASKLOOP_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF		\
@@ -3097,14 +3282,14 @@ gfc_match_omp_flush (void)
     {
       gfc_error ("List specified together with memory order clause in FLUSH "
 		 "directive at %C");
-      gfc_free_omp_namelist (list);
+      gfc_free_omp_namelist (list, false);
       gfc_free_omp_clauses (c);
       return MATCH_ERROR;
     }
   if (gfc_match_omp_eos () != MATCH_YES)
     {
       gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
-      gfc_free_omp_namelist (list);
+      gfc_free_omp_namelist (list, false);
       gfc_free_omp_clauses (c);
       return MATCH_ERROR;
     }
@@ -4252,14 +4437,13 @@ gfc_match_omp_taskloop_simd (void)
 match
 gfc_match_omp_taskwait (void)
 {
-  if (gfc_match_omp_eos () != MATCH_YES)
+  if (gfc_match_omp_eos () == MATCH_YES)
     {
-      gfc_error ("Unexpected junk after TASKWAIT clause at %C");
-      return MATCH_ERROR;
+      new_st.op = EXEC_OMP_TASKWAIT;
+      new_st.ext.omp_clauses = NULL;
+      return MATCH_YES;
     }
-  new_st.op = EXEC_OMP_TASKWAIT;
-  new_st.ext.omp_clauses = NULL;
-  return MATCH_YES;
+  return match_omp (EXEC_OMP_TASKWAIT, omp_mask (OMP_CLAUSE_DEPEND));
 }
 
 
@@ -4825,7 +5009,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
   gfc_omp_linear_op linear_op = OMP_LINEAR_DEFAULT;
   static const char *clause_names[]
     = { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
-	"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
+	"COPYIN", "UNIFORM", "AFFINITY", "ALIGNED", "LINEAR", "DEPEND", "MAP",
 	"TO", "FROM", "INCLUSIVE", "EXCLUSIVE",
 	"REDUCTION", "REDUCTION" /*inscan*/, "REDUCTION" /*task*/,
 	"IN_REDUCTION", "TASK_REDUCTION",
@@ -5273,6 +5457,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		  }
 	      }
 	    break;
+	  case OMP_LIST_AFFINITY:
 	  case OMP_LIST_DEPEND:
 	  case OMP_LIST_MAP:
 	  case OMP_LIST_TO:
@@ -5280,6 +5465,40 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	  case OMP_LIST_CACHE:
 	    for (; n != NULL; n = n->next)
 	      {
+		if ((list == OMP_LIST_DEPEND || list == OMP_LIST_AFFINITY)
+		    && n->u2.ns && !n->u2.ns->resolved)
+		  {
+		    n->u2.ns->resolved = 1;
+		    for (gfc_symbol *sym = n->u2.ns->proc_name; sym;
+			 sym = sym->tlink)
+		      {
+			gfc_constructor *c;
+			c = gfc_constructor_first (sym->value->value.constructor);
+			if (!gfc_resolve_expr (c->expr)
+			    || c->expr->ts.type != BT_INTEGER
+			    || c->expr->rank != 0)
+			  gfc_error ("Scalar integer expression for range begin"
+				     " expected at %L", &c->expr->where);
+			c = gfc_constructor_next (c);
+			if (!gfc_resolve_expr (c->expr)
+			    || c->expr->ts.type != BT_INTEGER
+			    || c->expr->rank != 0)
+			  gfc_error ("Scalar integer expression for range end "
+				     "expected at %L", &c->expr->where);
+			c = gfc_constructor_next (c);
+			if (c && (!gfc_resolve_expr (c->expr)
+				  || c->expr->ts.type != BT_INTEGER
+				  || c->expr->rank != 0))
+			  gfc_error ("Scalar integer expression for range step "
+				     "expected at %L", &c->expr->where);
+			else if (c
+				 && c->expr->expr_type == EXPR_CONSTANT
+				 && mpz_cmp_si (c->expr->value.integer, 0) == 0)
+			  gfc_error ("Nonzero range step expected at %L",
+				     &c->expr->where);
+		      }
+		  }
+
 		if (list == OMP_LIST_DEPEND)
 		  {
 		    if (n->u.depend_op == OMP_DEPEND_SINK_FIRST
@@ -5421,7 +5640,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 					 n->sym->name, name, &n->where);
 			      break;
 			    }
-			  else if (list == OMP_LIST_DEPEND
+			  else if ((list == OMP_LIST_DEPEND
+				    || list == OMP_LIST_AFFINITY)
 				   && ar->start[i]
 				   && ar->start[i]->expr_type == EXPR_CONSTANT
 				   && ar->end[i]
@@ -5429,9 +5649,11 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 				   && mpz_cmp (ar->start[i]->value.integer,
 					       ar->end[i]->value.integer) > 0)
 			    {
-			      gfc_error ("%qs in DEPEND clause at %L is a "
+			      gfc_error ("%qs in %s clause at %L is a "
 					 "zero size array section",
-					 n->sym->name, &n->where);
+					 n->sym->name,
+					 list == OMP_LIST_DEPEND
+					 ? "DEPEND" : "AFFINITY", &n->where);
 			      break;
 			    }
 		      }
@@ -5675,23 +5897,23 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			break;
 		      }
 		    if (!bad)
-		      n->udr = NULL;
+		      n->u2.udr = NULL;
 		    else
 		      {
 			const char *udr_name = NULL;
-			if (n->udr)
+			if (n->u2.udr)
 			  {
-			    udr_name = n->udr->udr->name;
-			    n->udr->udr
+			    udr_name = n->u2.udr->udr->name;
+			    n->u2.udr->udr
 			      = gfc_find_omp_udr (NULL, udr_name,
 						  &n->sym->ts);
-			    if (n->udr->udr == NULL)
+			    if (n->u2.udr->udr == NULL)
 			      {
-				free (n->udr);
-				n->udr = NULL;
+				free (n->u2.udr);
+				n->u2.udr = NULL;
 			      }
 			  }
-			if (n->udr == NULL)
+			if (n->u2.udr == NULL)
 			  {
 			    if (udr_name == NULL)
 			      switch (n->u.reduction_op)
@@ -5730,14 +5952,14 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			  }
 			else
 			  {
-			    gfc_omp_udr *udr = n->udr->udr;
+			    gfc_omp_udr *udr = n->u2.udr->udr;
 			    n->u.reduction_op = OMP_REDUCTION_USER;
-			    n->udr->combiner
+			    n->u2.udr->combiner
 			      = resolve_omp_udr_clause (n, udr->combiner_ns,
 							udr->omp_out,
 							udr->omp_in);
 			    if (udr->initializer_ns)
-			      n->udr->initializer
+			      n->u2.udr->initializer
 				= resolve_omp_udr_clause (n,
 							  udr->initializer_ns,
 							  udr->omp_priv,
@@ -7369,6 +7591,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_TARGET_PARALLEL:
     case EXEC_OMP_TARGET_TEAMS:
     case EXEC_OMP_TASK:
+    case EXEC_OMP_TASKWAIT:
     case EXEC_OMP_TEAMS:
     case EXEC_OMP_WORKSHARE:
     case EXEC_OMP_DEPOBJ:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 02a81da..7d0e2c1 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -268,7 +268,7 @@ gfc_free_statement (gfc_code *p)
       break;
 
     case EXEC_OMP_FLUSH:
-      gfc_free_omp_namelist (p->ext.omp_namelist);
+      gfc_free_omp_namelist (p->ext.omp_namelist, false);
       break;
 
     case EXEC_OMP_BARRIER:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 44542d9..7ea7aa3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -35,6 +35,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-array.h"
 #include "trans-const.h"
 #include "arith.h"
+#include "constructor.h"
 #include "gomp-constants.h"
 #include "omp-general.h"
 #include "omp-low.h"
@@ -1910,7 +1911,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   locus old_loc = gfc_current_locus;
   const char *iname;
   bool t;
-  gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL;
+  gfc_omp_udr *udr = n->u2.udr ? n->u2.udr->udr : NULL;
 
   decl = OMP_CLAUSE_DECL (c);
   gfc_current_locus = where;
@@ -2029,9 +2030,9 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
       t = gfc_resolve_expr (e2);
       gcc_assert (t);
     }
-  else if (n->udr->initializer->op == EXEC_ASSIGN)
+  else if (n->u2.udr->initializer->op == EXEC_ASSIGN)
     {
-      e2 = gfc_copy_expr (n->udr->initializer->expr2);
+      e2 = gfc_copy_expr (n->u2.udr->initializer->expr2);
       t = gfc_resolve_expr (e2);
       gcc_assert (t);
     }
@@ -2040,7 +2041,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
       struct omp_udr_find_orig_data cd;
       cd.omp_udr = udr;
       cd.omp_orig_seen = false;
-      gfc_code_walker (&n->udr->initializer,
+      gfc_code_walker (&n->u2.udr->initializer,
 		       gfc_dummy_code_callback, omp_udr_find_orig, &cd);
       if (cd.omp_orig_seen)
 	OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1;
@@ -2090,11 +2091,11 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
       iname = "ieor";
       break;
     case ERROR_MARK:
-      if (n->udr->combiner->op == EXEC_ASSIGN)
+      if (n->u2.udr->combiner->op == EXEC_ASSIGN)
 	{
 	  gfc_free_expr (e3);
-	  e3 = gfc_copy_expr (n->udr->combiner->expr1);
-	  e4 = gfc_copy_expr (n->udr->combiner->expr2);
+	  e3 = gfc_copy_expr (n->u2.udr->combiner->expr1);
+	  e4 = gfc_copy_expr (n->u2.udr->combiner->expr2);
 	  t = gfc_resolve_expr (e3);
 	  gcc_assert (t);
 	  t = gfc_resolve_expr (e4);
@@ -2144,7 +2145,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   if (e2)
     stmt = gfc_trans_assignment (e1, e2, false, false);
   else
-    stmt = gfc_trans_call (n->udr->initializer, false,
+    stmt = gfc_trans_call (n->u2.udr->initializer, false,
 			   NULL_TREE, NULL_TREE, false);
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -2157,7 +2158,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   if (e4)
     stmt = gfc_trans_assignment (e3, e4, false, true);
   else
-    stmt = gfc_trans_call (n->udr->combiner, false,
+    stmt = gfc_trans_call (n->u2.udr->combiner, false,
 			   NULL_TREE, NULL_TREE, false);
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -2433,13 +2434,76 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n,
 }
 
 static tree
+handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block)
+{
+  tree list = NULL_TREE;
+  for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink)
+    {
+      gfc_constructor *c;
+      gfc_se se;
+
+      tree last = make_tree_vec (6);
+      tree iter_var = gfc_get_symbol_decl (sym);
+      tree type = TREE_TYPE (iter_var);
+      TREE_VEC_ELT (last, 0) = iter_var;
+      DECL_CHAIN (iter_var) = BLOCK_VARS (block);
+      BLOCK_VARS (block) = iter_var;
+
+      /* begin */
+      c = gfc_constructor_first (sym->value->value.constructor);
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, c->expr);
+      gfc_add_block_to_block (iter_block, &se.pre);
+      gfc_add_block_to_block (iter_block, &se.post);
+      TREE_VEC_ELT (last, 1) = fold_convert (type,
+					     gfc_evaluate_now (se.expr,
+							       iter_block));
+      /* end */
+      c = gfc_constructor_next (c);
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, c->expr);
+      gfc_add_block_to_block (iter_block, &se.pre);
+      gfc_add_block_to_block (iter_block, &se.post);
+      TREE_VEC_ELT (last, 2) = fold_convert (type,
+					     gfc_evaluate_now (se.expr,
+							       iter_block));
+      /* step */
+      c = gfc_constructor_next (c);
+      tree step;
+      if (c)
+	{
+	  gfc_init_se (&se, NULL);
+	  gfc_conv_expr (&se, c->expr);
+	  gfc_add_block_to_block (iter_block, &se.pre);
+	  gfc_add_block_to_block (iter_block, &se.post);
+	  gfc_conv_expr (&se, c->expr);
+	  step = fold_convert (type,
+			       gfc_evaluate_now (se.expr,
+						 iter_block));
+	}
+      else
+	step = build_int_cst (type, 1);
+      TREE_VEC_ELT (last, 3) = step;
+      /* orig_step */
+      TREE_VEC_ELT (last, 4) = save_expr (step);
+      TREE_CHAIN (last) = list;
+      list = last;
+    }
+  return list;
+}
+
+static tree
 gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		       locus where, bool declare_simd = false,
 		       bool openacc = false)
 {
-  tree omp_clauses = NULL_TREE, chunk_size, c;
+  tree omp_clauses = NULL_TREE, prev_clauses, chunk_size, c;
+  tree iterator = NULL_TREE;
+  tree tree_block = NULL_TREE;
+  stmtblock_t iter_block;
   int list, ifc;
   enum omp_clause_code clause_code;
+  gfc_omp_namelist *prev = NULL;
   gfc_se se;
 
   if (clauses == NULL)
@@ -2642,10 +2706,38 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      }
 	  }
 	  break;
+	case OMP_LIST_AFFINITY:
 	case OMP_LIST_DEPEND:
+	  iterator = NULL_TREE;
+	  prev = NULL;
+	  prev_clauses = omp_clauses;
 	  for (; n != NULL; n = n->next)
 	    {
-	      if (n->u.depend_op == OMP_DEPEND_SINK_FIRST)
+	      if (iterator && prev->u2.ns != n->u2.ns)
+		{ 
+		  BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+		  TREE_VEC_ELT (iterator, 5) = tree_block;
+		  for (tree c = omp_clauses; c != prev_clauses;
+		       c = OMP_CLAUSE_CHAIN (c))
+		    OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
+							   OMP_CLAUSE_DECL (c));
+		  prev_clauses = omp_clauses;
+		  iterator = NULL_TREE;
+		}
+	      if (n->u2.ns && (!prev || prev->u2.ns != n->u2.ns))
+		{
+		  gfc_init_block (&iter_block);
+		  tree_block = make_node (BLOCK);
+		  TREE_USED (tree_block) = 1;
+		  BLOCK_VARS (tree_block) = NULL_TREE;
+		  iterator = handle_iterator (n->u2.ns, block,
+					      tree_block);
+		}
+	      if (!iterator)
+		gfc_init_block (&iter_block);
+	      prev = n;
+	      if (list == OMP_LIST_DEPEND
+		  && n->u.depend_op == OMP_DEPEND_SINK_FIRST)
 		{
 		  tree vec = NULL_TREE;
 		  unsigned int i;
@@ -2699,7 +2791,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	      if (!n->sym->attr.referenced)
 		continue;
 
-	      tree node = build_omp_clause (input_location, OMP_CLAUSE_DEPEND);
+	      tree node = build_omp_clause (input_location,
+					    list == OMP_LIST_DEPEND
+					    ? OMP_CLAUSE_DEPEND
+					    : OMP_CLAUSE_AFFINITY);
 	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
 		{
 		  tree decl = gfc_trans_omp_variable (n->sym, false);
@@ -2733,35 +2828,47 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      gfc_conv_expr_descriptor (&se, n->expr);
 		      ptr = gfc_conv_array_data (se.expr);
 		    }
-		  gfc_add_block_to_block (block, &se.pre);
-		  gfc_add_block_to_block (block, &se.post);
+		  gfc_add_block_to_block (&iter_block, &se.pre);
+		  gfc_add_block_to_block (&iter_block, &se.post);
 		  ptr = fold_convert (build_pointer_type (char_type_node),
 				      ptr);
 		  OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr);
 		}
-	      switch (n->u.depend_op)
-		{
-		case OMP_DEPEND_IN:
-		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
-		  break;
-		case OMP_DEPEND_OUT:
-		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
-		  break;
-		case OMP_DEPEND_INOUT:
-		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
-		  break;
-		case OMP_DEPEND_MUTEXINOUTSET:
-		  OMP_CLAUSE_DEPEND_KIND (node)
-		    = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
-		  break;
-		case OMP_DEPEND_DEPOBJ:
-		  OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
-		  break;
-		default:
-		  gcc_unreachable ();
-		}
+	      if (list == OMP_LIST_DEPEND)
+		switch (n->u.depend_op)
+		  {
+		  case OMP_DEPEND_IN:
+		    OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_IN;
+		    break;
+		  case OMP_DEPEND_OUT:
+		    OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_OUT;
+		    break;
+		  case OMP_DEPEND_INOUT:
+		    OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_INOUT;
+		    break;
+		  case OMP_DEPEND_MUTEXINOUTSET:
+		    OMP_CLAUSE_DEPEND_KIND (node)
+		      = OMP_CLAUSE_DEPEND_MUTEXINOUTSET;
+		    break;
+		  case OMP_DEPEND_DEPOBJ:
+		    OMP_CLAUSE_DEPEND_KIND (node) = OMP_CLAUSE_DEPEND_DEPOBJ;
+		    break;
+		  default:
+		    gcc_unreachable ();
+		  }
+	      if (!iterator)
+		gfc_add_block_to_block (block, &iter_block);
 	      omp_clauses = gfc_trans_add_clause (node, omp_clauses);
 	    }
+	  if (iterator)
+	    { 
+	      BLOCK_SUBBLOCKS (tree_block) = gfc_finish_block (&iter_block);
+	      TREE_VEC_ELT (iterator, 5) = tree_block;
+	      for (tree c = omp_clauses; c != prev_clauses;
+		   c = OMP_CLAUSE_CHAIN (c))
+		OMP_CLAUSE_DECL (c) = build_tree_list (iterator,
+						       OMP_CLAUSE_DECL (c));
+	    }
 	  break;
 	case OMP_LIST_MAP:
 	  for (; n != NULL; n = n->next)
@@ -5857,10 +5964,23 @@ gfc_trans_omp_taskgroup (gfc_code *code)
 }
 
 static tree
-gfc_trans_omp_taskwait (void)
+gfc_trans_omp_taskwait (gfc_code *code)
 {
-  tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
-  return build_call_expr_loc (input_location, decl, 0);
+  if (!code->ext.omp_clauses)
+    {
+      tree decl = builtin_decl_explicit (BUILT_IN_GOMP_TASKWAIT);
+      return build_call_expr_loc (input_location, decl, 0);
+    }
+  stmtblock_t block;
+  gfc_start_block (&block);
+  tree stmt = make_node (OMP_TASK);
+  TREE_TYPE (stmt) = void_type_node;
+  OMP_TASK_BODY (stmt) = NULL_TREE;
+  OMP_TASK_CLAUSES (stmt) = gfc_trans_omp_clauses (&block,
+						   code->ext.omp_clauses,
+						   code->loc);
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
 }
 
 static tree
@@ -6492,7 +6612,7 @@ gfc_trans_omp_directive (gfc_code *code)
     case EXEC_OMP_TASKLOOP_SIMD:
       return gfc_trans_omp_taskloop (code);
     case EXEC_OMP_TASKWAIT:
-      return gfc_trans_omp_taskwait ();
+      return gfc_trans_omp_taskwait (code);
     case EXEC_OMP_TASKYIELD:
       return gfc_trans_omp_taskyield ();
     case EXEC_OMP_TEAMS:
-- 
cgit v1.1


From 48166757dcf46d92cf1795dd7333dda7030179c8 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 29 May 2021 00:16:29 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d261101..2fc8b6f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,28 @@
+2021-05-28  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_iterator): New.
+	(show_omp_namelist): Handle iterators.
+	(show_omp_clauses): Handle affinity.
+	* gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'.
+	* match.c (gfc_free_omp_namelist): Add are to choose union element.
+	* openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach,
+	gfc_match_omp_clause_reduction, gfc_match_omp_flush): Update
+	call to gfc_free_omp_namelist.
+	(gfc_match_omp_variable_list): Likewise; permit preceeding whitespace.
+	(enum omp_mask1): Add OMP_CLAUSE_AFFINITY.
+	(gfc_match_iterator): New.
+	(gfc_match_omp_clauses): Use it; update call to gfc_free_omp_namelist.
+	(OMP_TASK_CLAUSES): Add OMP_CLAUSE_AFFINITY.
+	(gfc_match_omp_taskwait): Match depend clause.
+	(resolve_omp_clauses): Handle affinity; update for udr/union change.
+	(gfc_resolve_omp_directive): Resolve clauses of taskwait.
+	* st.c (gfc_free_statement): Update gfc_free_omp_namelist call.
+	* trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise
+	(handle_iterator): New.
+	(gfc_trans_omp_clauses): Handle iterators for depend/affinity clause.
+	(gfc_trans_omp_taskwait): Handle depend clause.
+	(gfc_trans_omp_directive): Update call.
+
 2021-05-27  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/100602
-- 
cgit v1.1


From a8f588be038317bf1e9c71f7e626a3d23255ab37 Mon Sep 17 00:00:00 2001
From: Gerald Pfeifer <gerald@pfeifer.com>
Date: Sun, 30 May 2021 15:27:53 +0200
Subject: Fortran: Fix typo in documentation of BOZ

gcc/fortran/ChangeLog:

2021-05-30  Gerald Pfeifer  <gerald@pfeifer.com>

	* gfortran.texi (BOZ literal constants): Fix typo.
---
 gcc/fortran/gfortran.texi | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 60bf257..a54153b 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -1842,7 +1842,7 @@ type, then the real-literal-constant will be interpreted as a
 
 Besides decimal constants, Fortran also supports binary (@code{b}),
 octal (@code{o}) and hexadecimal (@code{z}) integer constants.  The
-syntax is: @samp{prefix quote digits quote}, were the prefix is
+syntax is: @samp{prefix quote digits quote}, where the prefix is
 either @code{b}, @code{o} or @code{z}, quote is either @code{'} or
 @code{"} and the digits are @code{0} or @code{1} for binary,
 between @code{0} and @code{7} for octal, and between @code{0} and
-- 
cgit v1.1


From e21e93407202e62a10c372595076c593c561bb11 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Mon, 31 May 2021 00:16:25 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 4 ++++
 1 file changed, 4 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2fc8b6f..95857cc 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,7 @@
+2021-05-30  Gerald Pfeifer  <gerald@pfeifer.com>
+
+	* gfortran.texi (BOZ literal constants): Fix typo.
+
 2021-05-28  Tobias Burnus  <tobias@codesourcery.com>
 
 	* dump-parse-tree.c (show_iterator): New.
-- 
cgit v1.1


From f6bf436d9ab907d090823895abb7a2d5ba7ff50c Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 1 Jun 2021 12:46:37 +0200
Subject: Fortran/OpenMP: Support (parallel) master taskloop (simd) [PR99928]

	PR middle-end/99928

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
	(parallel) master taskloop (simd).
	* frontend-passes.c (gfc_code_walker): Set in_omp_workshare
	to false for parallel master taskloop (simd).
	* gfortran.h (enum gfc_statement):
	Add ST_OMP_(END_)(PARALLEL_)MASTER_TASKLOOP(_SIMD).
	(enum gfc_exec_op): EXEC_OMP_(PARALLEL_)MASTER_TASKLOOP(_SIMD).
	* match.h (gfc_match_omp_master_taskloop,
	gfc_match_omp_master_taskloop_simd,
	gfc_match_omp_parallel_master_taskloop,
	gfc_match_omp_parallel_master_taskloop_simd): New prototype.
	* openmp.c (gfc_match_omp_parallel_master_taskloop,
	gfc_match_omp_parallel_master_taskloop_simd,
	gfc_match_omp_master_taskloop,
	gfc_match_omp_master_taskloop_simd): New.
	(gfc_match_omp_taskloop_simd): Permit 'reduction' clause.
	(resolve_omp_clauses): Handle new combined directives; remove
	inscan-reduction check to reduce multiple errors; add
	task-reduction error for 'taskloop simd'.
	(gfc_resolve_omp_parallel_blocks,
	resolve_omp_do, omp_code_to_statement,
	gfc_resolve_omp_directive): Handle new combined constructs.
	* parse.c (decode_omp_directive, next_statement,
	gfc_ascii_statement, parse_omp_do, parse_omp_structured_block,
	parse_executable): Likewise.
	* resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise.
	* st.c (gfc_free_statement): Likewise.
	* trans.c (trans_code): Likewise.
	* trans-openmp.c (gfc_split_omp_clauses,
	gfc_trans_omp_directive): Likewise.
	(gfc_trans_omp_parallel_master): Move after gfc_trans_omp_master_taskloop;
	handle parallel master taskloop (simd) as well.
	(gfc_trans_omp_taskloop): Take gfc_exec_op as arg.
	(gfc_trans_omp_master_taskloop): New.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/reduction5.f90: Remove dg-error; the issue is
	now diagnosed with less error output.
	* gfortran.dg/gomp/scan-1.f90: Likewise.
	* gfortran.dg/gomp/pr99928-3.f90: New test.
	* gfortran.dg/gomp/taskloop-1.f90: New test.
---
 gcc/fortran/dump-parse-tree.c |  12 +++++
 gcc/fortran/frontend-passes.c |   2 +
 gcc/fortran/gfortran.h        |  10 +++-
 gcc/fortran/match.h           |   4 ++
 gcc/fortran/openmp.c          |  85 +++++++++++++++++++++++++++++---
 gcc/fortran/parse.c           |  73 ++++++++++++++++++++++++++-
 gcc/fortran/resolve.c         |  10 ++++
 gcc/fortran/st.c              |   4 ++
 gcc/fortran/trans-openmp.c    | 112 ++++++++++++++++++++++++++++++++----------
 gcc/fortran/trans.c           |   4 ++
 10 files changed, 282 insertions(+), 34 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 93ff572..0e7fe1c 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1898,12 +1898,18 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
     case EXEC_OMP_MASTER: name = "MASTER"; break;
+    case EXEC_OMP_MASTER_TASKLOOP: name = "MASTER TASKLOOP"; break;
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD: name = "MASTER TASKLOOP SIMD"; break;
     case EXEC_OMP_ORDERED: name = "ORDERED"; break;
     case EXEC_OMP_DEPOBJ: name = "DEPOBJ"; break;
     case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
     case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
     case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
     case EXEC_OMP_PARALLEL_MASTER: name = "PARALLEL MASTER"; break;
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+      name = "PARALLEL MASTER TASKLOOP"; break;
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+      name = "PARALLEL MASTER TASKLOOP SIMD"; break;
     case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
     case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
     case EXEC_OMP_SCAN: name = "SCAN"; break;
@@ -1976,6 +1982,8 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_MASTER:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
@@ -3184,11 +3192,15 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_FLUSH:
     case EXEC_OMP_MASTER:
+    case EXEC_OMP_MASTER_TASKLOOP:
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_ORDERED:
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_MASTER:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index ffe2db4..e3b1d15 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5543,6 +5543,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_DO_SIMD:
 	    case EXEC_OMP_PARALLEL_MASTER:
+	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
 	    case EXEC_OMP_PARALLEL_SECTIONS:
 
 	      in_omp_workshare = false;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 55fba04..2020ab4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -267,7 +267,11 @@ enum gfc_statement
   ST_GET_FCN_CHARACTERISTICS, ST_LOCK, ST_UNLOCK, ST_EVENT_POST,
   ST_EVENT_WAIT, ST_FAIL_IMAGE, ST_FORM_TEAM, ST_CHANGE_TEAM,
   ST_END_TEAM, ST_SYNC_TEAM,  ST_OMP_PARALLEL_MASTER,
-  ST_OMP_END_PARALLEL_MASTER, ST_NONE
+  ST_OMP_END_PARALLEL_MASTER, ST_OMP_PARALLEL_MASTER_TASKLOOP,
+  ST_OMP_END_PARALLEL_MASTER_TASKLOOP, ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD,
+  ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD, ST_OMP_MASTER_TASKLOOP,
+  ST_OMP_END_MASTER_TASKLOOP, ST_OMP_MASTER_TASKLOOP_SIMD,
+  ST_OMP_END_MASTER_TASKLOOP_SIMD, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -2711,7 +2715,9 @@ enum gfc_exec_op
   EXEC_OMP_TARGET_PARALLEL, EXEC_OMP_TARGET_PARALLEL_DO,
   EXEC_OMP_TARGET_PARALLEL_DO_SIMD, EXEC_OMP_TARGET_SIMD,
   EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ,
-  EXEC_OMP_PARALLEL_MASTER
+  EXEC_OMP_PARALLEL_MASTER, EXEC_OMP_PARALLEL_MASTER_TASKLOOP,
+  EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD, EXEC_OMP_MASTER_TASKLOOP,
+  EXEC_OMP_MASTER_TASKLOOP_SIMD
 };
 
 typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 09c5723..bcedf8e 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -169,12 +169,16 @@ match gfc_match_omp_do (void);
 match gfc_match_omp_do_simd (void);
 match gfc_match_omp_flush (void);
 match gfc_match_omp_master (void);
+match gfc_match_omp_master_taskloop (void);
+match gfc_match_omp_master_taskloop_simd (void);
 match gfc_match_omp_ordered (void);
 match gfc_match_omp_ordered_depend (void);
 match gfc_match_omp_parallel (void);
 match gfc_match_omp_parallel_do (void);
 match gfc_match_omp_parallel_do_simd (void);
 match gfc_match_omp_parallel_master (void);
+match gfc_match_omp_parallel_master_taskloop (void);
+match gfc_match_omp_parallel_master_taskloop_simd (void);
 match gfc_match_omp_parallel_sections (void);
 match gfc_match_omp_parallel_workshare (void);
 match gfc_match_omp_requires (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 4ed6a0d..9dba165 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -3995,6 +3995,22 @@ gfc_match_omp_parallel_master (void)
   return match_omp (EXEC_OMP_PARALLEL_MASTER, OMP_PARALLEL_CLAUSES);
 }
 
+match
+gfc_match_omp_parallel_master_taskloop (void)
+{
+  return match_omp (EXEC_OMP_PARALLEL_MASTER_TASKLOOP,
+		    (OMP_PARALLEL_CLAUSES | OMP_TASKLOOP_CLAUSES)
+		    & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION)));
+}
+
+match
+gfc_match_omp_parallel_master_taskloop_simd (void)
+{
+  return match_omp (EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD,
+		    (OMP_PARALLEL_CLAUSES | OMP_TASKLOOP_CLAUSES
+		     | OMP_SIMD_CLAUSES)
+		    & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION)));
+}
 
 match
 gfc_match_omp_parallel_sections (void)
@@ -4429,8 +4445,7 @@ match
 gfc_match_omp_taskloop_simd (void)
 {
   return match_omp (EXEC_OMP_TASKLOOP_SIMD,
-		    (OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES)
-		    & ~(omp_mask (OMP_CLAUSE_REDUCTION)));
+		    OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES);
 }
 
 
@@ -4533,6 +4548,18 @@ gfc_match_omp_master (void)
   return MATCH_YES;
 }
 
+match
+gfc_match_omp_master_taskloop (void)
+{
+  return match_omp (EXEC_OMP_MASTER_TASKLOOP, OMP_TASKLOOP_CLAUSES);
+}
+
+match
+gfc_match_omp_master_taskloop_simd (void)
+{
+  return match_omp (EXEC_OMP_MASTER_TASKLOOP_SIMD,
+		    OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES);
+}
 
 match
 gfc_match_omp_ordered (void)
@@ -5073,6 +5100,16 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	      ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_SIMD;
 	      break;
 
+	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+	      ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_TASKLOOP;
+	      break;
+
+	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+	      ok = (ifc == OMP_IF_PARALLEL
+		    || ifc == OMP_IF_TASKLOOP
+		    || ifc == OMP_IF_SIMD);
+	      break;
+
 	    case EXEC_OMP_SIMD:
 	    case EXEC_OMP_DO_SIMD:
 	    case EXEC_OMP_DISTRIBUTE_SIMD:
@@ -5085,10 +5122,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	      break;
 
 	    case EXEC_OMP_TASKLOOP:
+	    case EXEC_OMP_MASTER_TASKLOOP:
 	      ok = ifc == OMP_IF_TASKLOOP;
 	      break;
 
 	    case EXEC_OMP_TASKLOOP_SIMD:
+	    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
 	      ok = ifc == OMP_IF_TASKLOOP || ifc == OMP_IF_SIMD;
 	      break;
 
@@ -5848,11 +5887,16 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			     n->sym->name, name, &n->where);
 		switch (list)
 		  {
-		  case OMP_LIST_REDUCTION_INSCAN:
 		  case OMP_LIST_REDUCTION_TASK:
-		    if (code && (code->op == EXEC_OMP_TASKLOOP
-				 || code->op == EXEC_OMP_TEAMS
-				 || code->op == EXEC_OMP_TEAMS_DISTRIBUTE))
+		    if (code
+			&& (code->op == EXEC_OMP_TASKLOOP
+			    || code->op == EXEC_OMP_TASKLOOP_SIMD
+			    || code->op == EXEC_OMP_MASTER_TASKLOOP
+			    || code->op == EXEC_OMP_MASTER_TASKLOOP_SIMD
+			    || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP
+			    || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
+			    || code->op == EXEC_OMP_TEAMS
+			    || code->op == EXEC_OMP_TEAMS_DISTRIBUTE))
 		      {
 			gfc_error ("Only DEFAULT permitted as reduction-"
 				   "modifier in REDUCTION clause at %L",
@@ -5863,6 +5907,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		  case OMP_LIST_REDUCTION:
 		  case OMP_LIST_IN_REDUCTION:
 		  case OMP_LIST_TASK_REDUCTION:
+		  case OMP_LIST_REDUCTION_INSCAN:
 		    switch (n->u.reduction_op)
 		      {
 		      case OMP_REDUCTION_PLUS:
@@ -6766,6 +6811,10 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_MASTER_TASKLOOP:
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_TARGET_PARALLEL_DO:
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
@@ -6909,6 +6958,18 @@ resolve_omp_do (gfc_code *code)
       name = "!$OMP PARALLEL DO SIMD";
       is_simd = true;
       break;
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+      name = "!$OMP PARALLEL MASTER TASKLOOP";
+      break;
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+      name = "!$OMP PARALLEL MASTER TASKLOOP SIMD";
+      is_simd = true;
+      break;
+    case EXEC_OMP_MASTER_TASKLOOP: name = "!$OMP MASTER TASKLOOP"; break;
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+      name = "!$OMP MASTER TASKLOOP SIMD";
+      is_simd = true;
+      break;
     case EXEC_OMP_SIMD: name = "!$OMP SIMD"; is_simd = true; break;
     case EXEC_OMP_TARGET_PARALLEL_DO: name = "!$OMP TARGET PARALLEL DO"; break;
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
@@ -7063,6 +7124,10 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_PARALLEL;
     case EXEC_OMP_PARALLEL_MASTER:
       return ST_OMP_PARALLEL_MASTER;
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+      return ST_OMP_PARALLEL_MASTER_TASKLOOP;
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+      return ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD;
     case EXEC_OMP_PARALLEL_SECTIONS:
       return ST_OMP_PARALLEL_SECTIONS;
     case EXEC_OMP_SECTIONS:
@@ -7073,6 +7138,10 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_CRITICAL;
     case EXEC_OMP_MASTER:
       return ST_OMP_MASTER;
+    case EXEC_OMP_MASTER_TASKLOOP:
+      return ST_OMP_MASTER_TASKLOOP;
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+      return ST_OMP_MASTER_TASKLOOP_SIMD;
     case EXEC_OMP_SINGLE:
       return ST_OMP_SINGLE;
     case EXEC_OMP_TASK:
@@ -7561,6 +7630,10 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_MASTER_TASKLOOP:
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_SIMD:
     case EXEC_OMP_TARGET_PARALLEL_DO:
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 6efb3fd..c44e23c 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -920,11 +920,19 @@ decode_omp_directive (void)
       matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD);
       matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
       matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD);
+      matcho ("end master taskloop simd", gfc_match_omp_eos_error,
+	      ST_OMP_END_MASTER_TASKLOOP_SIMD);
+      matcho ("end master taskloop", gfc_match_omp_eos_error,
+	      ST_OMP_END_MASTER_TASKLOOP);
       matcho ("end master", gfc_match_omp_eos_error, ST_OMP_END_MASTER);
       matchs ("end ordered", gfc_match_omp_eos_error, ST_OMP_END_ORDERED);
       matchs ("end parallel do simd", gfc_match_omp_eos_error,
 	      ST_OMP_END_PARALLEL_DO_SIMD);
       matcho ("end parallel do", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO);
+      matcho ("end parallel master taskloop simd", gfc_match_omp_eos_error,
+	      ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD);
+      matcho ("end parallel master taskloop", gfc_match_omp_eos_error,
+	      ST_OMP_END_PARALLEL_MASTER_TASKLOOP);
       matcho ("end parallel master", gfc_match_omp_eos_error,
 	      ST_OMP_END_PARALLEL_MASTER);
       matcho ("end parallel sections", gfc_match_omp_eos_error,
@@ -974,6 +982,10 @@ decode_omp_directive (void)
       matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
       break;
     case 'm':
+      matcho ("master taskloop simd", gfc_match_omp_master_taskloop_simd,
+	      ST_OMP_MASTER_TASKLOOP_SIMD);
+      matcho ("master taskloop", gfc_match_omp_master_taskloop,
+	      ST_OMP_MASTER_TASKLOOP);
       matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
       break;
     case 'o':
@@ -992,6 +1004,12 @@ decode_omp_directive (void)
       matchs ("parallel do simd", gfc_match_omp_parallel_do_simd,
 	      ST_OMP_PARALLEL_DO_SIMD);
       matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
+      matcho ("parallel master taskloop simd",
+	      gfc_match_omp_parallel_master_taskloop_simd,
+	      ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD);
+      matcho ("parallel master taskloop",
+	      gfc_match_omp_parallel_master_taskloop,
+	      ST_OMP_PARALLEL_MASTER_TASKLOOP);
       matcho ("parallel master", gfc_match_omp_parallel_master,
 	      ST_OMP_PARALLEL_MASTER);
       matcho ("parallel sections", gfc_match_omp_parallel_sections,
@@ -1610,8 +1628,11 @@ next_statement (void)
   case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \
   case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \
   case ST_SELECT_RANK: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASTER: \
+  case ST_OMP_PARALLEL_MASTER_TASKLOOP: \
+  case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: \
   case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \
-  case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_SINGLE: \
+  case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \
+  case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SINGLE: \
   case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
   case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
   case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \
@@ -2341,6 +2362,12 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_MASTER:
       p = "!$OMP END MASTER";
       break;
+    case ST_OMP_END_MASTER_TASKLOOP:
+      p = "!$OMP END MASTER TASKLOOP";
+      break;
+    case ST_OMP_END_MASTER_TASKLOOP_SIMD:
+      p = "!$OMP END MASTER TASKLOOP SIMD";
+      break;
     case ST_OMP_END_ORDERED:
       p = "!$OMP END ORDERED";
       break;
@@ -2356,6 +2383,12 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_PARALLEL_MASTER:
       p = "!$OMP END PARALLEL MASTER";
       break;
+    case ST_OMP_END_PARALLEL_MASTER_TASKLOOP:
+      p = "!$OMP END PARALLEL MASTER TASKLOOP";
+      break;
+    case ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD:
+      p = "!$OMP END PARALLEL MASTER TASKLOOP SIMD";
+      break;
     case ST_OMP_END_PARALLEL_SECTIONS:
       p = "!$OMP END PARALLEL SECTIONS";
       break;
@@ -2437,6 +2470,12 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_MASTER:
       p = "!$OMP MASTER";
       break;
+    case ST_OMP_MASTER_TASKLOOP:
+      p = "!$OMP MASTER TASKLOOP";
+      break;
+    case ST_OMP_MASTER_TASKLOOP_SIMD:
+      p = "!$OMP MASTER TASKLOOP SIMD";
+      break;
     case ST_OMP_ORDERED:
     case ST_OMP_ORDERED_DEPEND:
       p = "!$OMP ORDERED";
@@ -2453,6 +2492,12 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_PARALLEL_MASTER:
       p = "!$OMP PARALLEL MASTER";
       break;
+    case ST_OMP_PARALLEL_MASTER_TASKLOOP:
+      p = "!$OMP PARALLEL MASTER TASKLOOP";
+      break;
+    case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+      p = "!$OMP PARALLEL MASTER TASKLOOP SIMD";
+      break;
     case ST_OMP_PARALLEL_SECTIONS:
       p = "!$OMP PARALLEL SECTIONS";
       break;
@@ -5025,6 +5070,16 @@ parse_omp_do (gfc_statement omp_st)
       break;
     case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break;
     case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break;
+    case ST_OMP_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_MASTER_TASKLOOP; break;
+    case ST_OMP_MASTER_TASKLOOP_SIMD:
+      omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD;
+      break;
+    case ST_OMP_PARALLEL_MASTER_TASKLOOP:
+      omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
+      break;
+    case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+      omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
+      break;
     case ST_OMP_TEAMS_DISTRIBUTE:
       omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
       break;
@@ -5268,6 +5323,12 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_PARALLEL_MASTER:
       omp_end_st = ST_OMP_END_PARALLEL_MASTER;
       break;
+    case ST_OMP_PARALLEL_MASTER_TASKLOOP:
+      omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
+      break;
+    case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+      omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
+      break;
     case ST_OMP_PARALLEL_SECTIONS:
       omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
       break;
@@ -5283,6 +5344,12 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_MASTER:
       omp_end_st = ST_OMP_END_MASTER;
       break;
+    case ST_OMP_MASTER_TASKLOOP:
+      omp_end_st = ST_OMP_END_MASTER_TASKLOOP;
+      break;
+    case ST_OMP_MASTER_TASKLOOP_SIMD:
+      omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD;
+      break;
     case ST_OMP_SINGLE:
       omp_end_st = ST_OMP_END_SINGLE;
       break;
@@ -5624,6 +5691,10 @@ parse_executable (gfc_statement st)
 	case ST_OMP_DO_SIMD:
 	case ST_OMP_PARALLEL_DO:
 	case ST_OMP_PARALLEL_DO_SIMD:
+	case ST_OMP_PARALLEL_MASTER_TASKLOOP:
+	case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+	case ST_OMP_MASTER_TASKLOOP:
+	case ST_OMP_MASTER_TASKLOOP_SIMD:
 	case ST_OMP_SIMD:
 	case ST_OMP_TARGET_PARALLEL_DO:
 	case ST_OMP_TARGET_PARALLEL_DO_SIMD:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 747516f..fed6dce 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10798,11 +10798,15 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
 	case EXEC_OMP_MASTER:
+	case EXEC_OMP_MASTER_TASKLOOP:
+	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
 	case EXEC_OMP_ORDERED:
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
 	case EXEC_OMP_PARALLEL_MASTER:
+	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
 	case EXEC_OMP_PARALLEL_SECTIONS:
 	case EXEC_OMP_PARALLEL_WORKSHARE:
 	case EXEC_OMP_SECTIONS:
@@ -11765,6 +11769,8 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_DO_SIMD:
 	    case EXEC_OMP_PARALLEL_MASTER:
+	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
 	    case EXEC_OMP_PARALLEL_SECTIONS:
 	    case EXEC_OMP_TARGET_PARALLEL:
 	    case EXEC_OMP_TARGET_PARALLEL_DO:
@@ -12214,6 +12220,8 @@ start:
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
 	case EXEC_OMP_MASTER:
+	case EXEC_OMP_MASTER_TASKLOOP:
+	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
 	case EXEC_OMP_ORDERED:
 	case EXEC_OMP_SCAN:
 	case EXEC_OMP_SECTIONS:
@@ -12252,6 +12260,8 @@ start:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
 	case EXEC_OMP_PARALLEL_MASTER:
+	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
 	case EXEC_OMP_PARALLEL_SECTIONS:
 	case EXEC_OMP_PARALLEL_WORKSHARE:
 	  omp_workshare_save = omp_workshare_flag;
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 7d0e2c1..9f6fe49 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -226,11 +226,15 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_END_SINGLE:
+    case EXEC_OMP_MASTER_TASKLOOP:
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_ORDERED:
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_MASTER:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 7ea7aa3..2917d3d 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -5380,6 +5380,14 @@ gfc_split_omp_clauses (gfc_code *code,
       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_SIMD;
       break;
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+      mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
+      innermost = GFC_OMP_SPLIT_TASKLOOP;
+      break;
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+      mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
+      innermost = GFC_OMP_SPLIT_SIMD;
+      break;
     case EXEC_OMP_SIMD:
       innermost = GFC_OMP_SPLIT_SIMD;
       break;
@@ -5427,9 +5435,11 @@ gfc_split_omp_clauses (gfc_code *code,
 	     | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_SIMD;
       break;
+    case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_TASKLOOP:
       innermost = GFC_OMP_SPLIT_TASKLOOP;
       break;
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_TASKLOOP_SIMD:
       mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_SIMD;
@@ -5821,28 +5831,6 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
 }
 
 static tree
-gfc_trans_omp_parallel_master (gfc_code *code)
-{
-  stmtblock_t block;
-  tree stmt, omp_clauses;
-
-  gfc_start_block (&block);
-  omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
-				       code->loc);
-  pushlevel ();
-  stmt = gfc_trans_omp_master (code);
-  if (TREE_CODE (stmt) != BIND_EXPR)
-    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
-  else
-    poplevel (0, 0);
-  stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
-		     void_type_node, stmt, omp_clauses);
-  OMP_PARALLEL_COMBINED (stmt) = 1;
-  gfc_add_expr_to_block (&block, stmt);
-  return gfc_finish_block (&block);
-}
-
-static tree
 gfc_trans_omp_parallel_sections (gfc_code *code)
 {
   stmtblock_t block;
@@ -6217,7 +6205,7 @@ gfc_trans_omp_target (gfc_code *code)
 }
 
 static tree
-gfc_trans_omp_taskloop (gfc_code *code)
+gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op)
 {
   stmtblock_t block;
   gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
@@ -6229,7 +6217,7 @@ gfc_trans_omp_taskloop (gfc_code *code)
     omp_clauses
       = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_TASKLOOP],
 			       code->loc);
-  switch (code->op)
+  switch (op)
     {
     case EXEC_OMP_TASKLOOP:
       /* This is handled in gfc_trans_omp_do.  */
@@ -6259,6 +6247,75 @@ gfc_trans_omp_taskloop (gfc_code *code)
 }
 
 static tree
+gfc_trans_omp_master_taskloop (gfc_code *code, gfc_exec_op op)
+{
+  stmtblock_t block;
+  tree stmt;
+
+  gfc_start_block (&block);
+  pushlevel ();
+  if (op == EXEC_OMP_MASTER_TASKLOOP_SIMD)
+    stmt = gfc_trans_omp_taskloop (code, EXEC_OMP_TASKLOOP_SIMD);
+  else
+    {
+      gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
+      gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP);
+      if (op != code->op)
+	gfc_split_omp_clauses (code, clausesa);
+      stmt = gfc_trans_omp_do (code, EXEC_OMP_TASKLOOP, NULL,
+			       op != code->op
+			       ? &clausesa[GFC_OMP_SPLIT_TASKLOOP]
+			       : code->ext.omp_clauses, NULL);
+    }
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
+  else
+    poplevel (0, 0);
+  stmt = build1_v (OMP_MASTER, stmt);
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
+gfc_trans_omp_parallel_master (gfc_code *code)
+{
+  stmtblock_t block;
+  tree stmt, omp_clauses;
+  gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
+
+  if (code->op != EXEC_OMP_PARALLEL_MASTER)
+    gfc_split_omp_clauses (code, clausesa);
+
+  gfc_start_block (&block);
+  omp_clauses = gfc_trans_omp_clauses (&block,
+				       code->op == EXEC_OMP_PARALLEL_MASTER
+				       ? code->ext.omp_clauses
+				       : &clausesa[GFC_OMP_SPLIT_PARALLEL],
+				       code->loc);
+  pushlevel ();
+  if (code->op == EXEC_OMP_PARALLEL_MASTER)
+    stmt = gfc_trans_omp_master (code);
+  else
+    {
+      gcc_assert (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP
+		  || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD);
+      gfc_exec_op op = (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP
+			? EXEC_OMP_MASTER_TASKLOOP
+			: EXEC_OMP_MASTER_TASKLOOP_SIMD);
+      stmt = gfc_trans_omp_master_taskloop (code, op);
+    }
+  if (TREE_CODE (stmt) != BIND_EXPR)
+    stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
+  else
+    poplevel (0, 0);
+  stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
+		     void_type_node, stmt, omp_clauses);
+  OMP_PARALLEL_COMBINED (stmt) = 1;
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
 gfc_trans_omp_target_data (gfc_code *code)
 {
   stmtblock_t block;
@@ -6568,6 +6625,9 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_flush (code);
     case EXEC_OMP_MASTER:
       return gfc_trans_omp_master (code);
+    case EXEC_OMP_MASTER_TASKLOOP:
+    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+      return gfc_trans_omp_master_taskloop (code, code->op);
     case EXEC_OMP_ORDERED:
       return gfc_trans_omp_ordered (code);
     case EXEC_OMP_PARALLEL:
@@ -6577,6 +6637,8 @@ gfc_trans_omp_directive (gfc_code *code)
     case EXEC_OMP_PARALLEL_DO_SIMD:
       return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
     case EXEC_OMP_PARALLEL_MASTER:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
       return gfc_trans_omp_parallel_master (code);
     case EXEC_OMP_PARALLEL_SECTIONS:
       return gfc_trans_omp_parallel_sections (code);
@@ -6610,7 +6672,7 @@ gfc_trans_omp_directive (gfc_code *code)
     case EXEC_OMP_TASKGROUP:
       return gfc_trans_omp_taskgroup (code);
     case EXEC_OMP_TASKLOOP_SIMD:
-      return gfc_trans_omp_taskloop (code);
+      return gfc_trans_omp_taskloop (code, code->op);
     case EXEC_OMP_TASKWAIT:
       return gfc_trans_omp_taskwait (code);
     case EXEC_OMP_TASKYIELD:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 9f296bd..cbbfcd9 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2170,11 +2170,15 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_DO_SIMD:
 	case EXEC_OMP_FLUSH:
 	case EXEC_OMP_MASTER:
+	case EXEC_OMP_MASTER_TASKLOOP:
+	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
 	case EXEC_OMP_ORDERED:
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
 	case EXEC_OMP_PARALLEL_MASTER:
+	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
 	case EXEC_OMP_PARALLEL_SECTIONS:
 	case EXEC_OMP_PARALLEL_WORKSHARE:
 	case EXEC_OMP_SECTIONS:
-- 
cgit v1.1


From b75978d14fc35981ffd8bf060ee52300db4dae50 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 2 Jun 2021 00:16:43 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 95857cc..bab25eb 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,41 @@
+2021-06-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR middle-end/99928
+	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
+	(parallel) master taskloop (simd).
+	* frontend-passes.c (gfc_code_walker): Set in_omp_workshare
+	to false for parallel master taskloop (simd).
+	* gfortran.h (enum gfc_statement):
+	Add ST_OMP_(END_)(PARALLEL_)MASTER_TASKLOOP(_SIMD).
+	(enum gfc_exec_op): EXEC_OMP_(PARALLEL_)MASTER_TASKLOOP(_SIMD).
+	* match.h (gfc_match_omp_master_taskloop,
+	gfc_match_omp_master_taskloop_simd,
+	gfc_match_omp_parallel_master_taskloop,
+	gfc_match_omp_parallel_master_taskloop_simd): New prototype.
+	* openmp.c (gfc_match_omp_parallel_master_taskloop,
+	gfc_match_omp_parallel_master_taskloop_simd,
+	gfc_match_omp_master_taskloop,
+	gfc_match_omp_master_taskloop_simd): New.
+	(gfc_match_omp_taskloop_simd): Permit 'reduction' clause.
+	(resolve_omp_clauses): Handle new combined directives; remove
+	inscan-reduction check to reduce multiple errors; add
+	task-reduction error for 'taskloop simd'.
+	(gfc_resolve_omp_parallel_blocks,
+	resolve_omp_do, omp_code_to_statement,
+	gfc_resolve_omp_directive): Handle new combined constructs.
+	* parse.c (decode_omp_directive, next_statement,
+	gfc_ascii_statement, parse_omp_do, parse_omp_structured_block,
+	parse_executable): Likewise.
+	* resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise.
+	* st.c (gfc_free_statement): Likewise.
+	* trans.c (trans_code): Likewise.
+	* trans-openmp.c (gfc_split_omp_clauses,
+	gfc_trans_omp_directive): Likewise.
+	(gfc_trans_omp_parallel_master): Move after gfc_trans_omp_master_taskloop;
+	handle parallel master taskloop (simd) as well.
+	(gfc_trans_omp_taskloop): Take gfc_exec_op as arg.
+	(gfc_trans_omp_master_taskloop): New.
+
 2021-05-30  Gerald Pfeifer  <gerald@pfeifer.com>
 
 	* gfortran.texi (BOZ literal constants): Fix typo.
-- 
cgit v1.1


From 178191e1dfafd8db149edcdef7a39e9e2c00f216 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 4 Jun 2021 12:06:59 +0200
Subject: Fortran/OpenMP: Add omp loop [PR99928]

	PR middle-end/99928

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle bind clause.
	(show_omp_node): Handle loop directive.
	* frontend-passes.c (gfc_code_walker): Likewise.
	* gfortran.h (enum gfc_statement): Add
	ST_OMP_(END_)(TARGET_)(|PARALLEL_|TEAMS_)LOOP.
	(enum gfc_omp_bind_type): New.
	(gfc_omp_clauses): Use it.
	(enum gfc_exec_op): Add EXEC_OMP_(TARGET_)(|PARALLEL_|TEAMS_)LOOP.
	* match.h (gfc_match_omp_loop, gfc_match_omp_parallel_loop,
	gfc_match_omp_target_parallel_loop, gfc_match_omp_target_teams_loop,
	gfc_match_omp_teams_loop): New.
	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_BIND.
	(gfc_match_omp_clauses): Handle it.
	(OMP_LOOP_CLAUSES, gfc_match_omp_loop, gfc_match_omp_teams_loop,
	gfc_match_omp_target_teams_loop, gfc_match_omp_parallel_loop,
	gfc_match_omp_target_parallel_loop): New.
	(resolve_omp_clauses, resolve_omp_do, omp_code_to_statement,
	gfc_resolve_omp_directive): Handle omp loop.
	* parse.c (decode_omp_directive case_exec_markers, gfc_ascii_statement,
	parse_omp_do, parse_executable): Likewise.
	(parse_omp_structured_block): Remove ST_ which use parse_omp_do.
	* resolve.c (gfc_resolve_blocks): Add omp loop.
	* st.c (gfc_free_statement): Likewise.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle bind clause.
	(gfc_trans_omp_do, gfc_trans_omp_parallel_do, gfc_trans_omp_distribute,
	gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_directive):
	Handle loop directive.
	(gfc_split_omp_clauses): Likewise; fix firstprivate/lastprivate
	and (in_)reduction for taskloop.
	* trans.c (trans_code): Handle omp loop directive.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/pr99928-3.f90: Add 'default(none)', following
	C/C++ version of the patch.
	* gfortran.dg/gomp/loop-1.f90: New test.
	* gfortran.dg/gomp/loop-2.f90: New test.
	* gfortran.dg/gomp/pr99928-1.f90: New test; based on C/C++ test.
	* gfortran.dg/gomp/pr99928-11.f90: Likewise.
	* gfortran.dg/gomp/pr99928-2.f90: Likewise.
	* gfortran.dg/gomp/pr99928-4.f90: Likewise.
	* gfortran.dg/gomp/pr99928-5.f90: Likewise.
	* gfortran.dg/gomp/pr99928-6.f90: Likewise.
	* gfortran.dg/gomp/pr99928-8.f90: Likewise.
	* gfortran.dg/goacc/omp.f95: Use 'acc kernels loops' instead
	of 'acc loops' to hide unrelated bug for now.
	* gfortran.dg/goacc/omp-fixed.f: Likewise
---
 gcc/fortran/dump-parse-tree.c |  23 +++++++++
 gcc/fortran/frontend-passes.c |   5 ++
 gcc/fortran/gfortran.h        |  18 ++++++-
 gcc/fortran/match.h           |   5 ++
 gcc/fortran/openmp.c          |  94 ++++++++++++++++++++++++++++++++-
 gcc/fortran/parse.c           | 104 ++++++++++++++++++++++---------------
 gcc/fortran/resolve.c         |  10 ++++
 gcc/fortran/st.c              |   5 ++
 gcc/fortran/trans-openmp.c    | 117 +++++++++++++++++++++++++++++++++++-------
 gcc/fortran/trans.c           |   5 ++
 10 files changed, 322 insertions(+), 64 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 0e7fe1c..8e2df73 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1718,6 +1718,19 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
 	}
       fprintf (dumpfile, " PROC_BIND(%s)", type);
     }
+  if (omp_clauses->bind != OMP_BIND_UNSET)
+    {
+      const char *type;
+      switch (omp_clauses->bind)
+	{
+	case OMP_BIND_TEAMS: type = "TEAMS"; break;
+	case OMP_BIND_PARALLEL: type = "PARALLEL"; break;
+	case OMP_BIND_THREAD: type = "THREAD"; break;
+	default:
+	  gcc_unreachable ();
+	}
+      fprintf (dumpfile, " BIND(%s)", type);
+    }
   if (omp_clauses->num_teams)
     {
       fputs (" NUM_TEAMS(", dumpfile);
@@ -1896,6 +1909,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break;
     case EXEC_OMP_DO: name = "DO"; break;
     case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
+    case EXEC_OMP_LOOP: name = "LOOP"; break;
     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
     case EXEC_OMP_MASTER: name = "MASTER"; break;
     case EXEC_OMP_MASTER_TASKLOOP: name = "MASTER TASKLOOP"; break;
@@ -1905,6 +1919,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
     case EXEC_OMP_PARALLEL_DO: name = "PARALLEL DO"; break;
     case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
+    case EXEC_OMP_PARALLEL_LOOP: name = "PARALLEL LOOP"; break;
     case EXEC_OMP_PARALLEL_MASTER: name = "PARALLEL MASTER"; break;
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
       name = "PARALLEL MASTER TASKLOOP"; break;
@@ -1924,6 +1939,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_TARGET_PARALLEL_DO: name = "TARGET PARALLEL DO"; break;
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
       name = "TARGET_PARALLEL_DO_SIMD"; break;
+    case EXEC_OMP_TARGET_PARALLEL_LOOP: name = "TARGET PARALLEL LOOP"; break;
     case EXEC_OMP_TARGET_SIMD: name = "TARGET SIMD"; break;
     case EXEC_OMP_TARGET_TEAMS: name = "TARGET TEAMS"; break;
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
@@ -1934,6 +1950,7 @@ show_omp_node (int level, gfc_code *c)
       name = "TARGET TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
       name = "TARGET TEAMS DISTRIBUTE SIMD"; break;
+    case EXEC_OMP_TARGET_TEAMS_LOOP: name = "TARGET TEAMS LOOP"; break;
     case EXEC_OMP_TARGET_UPDATE: name = "TARGET UPDATE"; break;
     case EXEC_OMP_TASK: name = "TASK"; break;
     case EXEC_OMP_TASKGROUP: name = "TASKGROUP"; break;
@@ -1948,6 +1965,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
       name = "TEAMS DISTRIBUTE PARALLEL DO SIMD"; break;
     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD: name = "TEAMS DISTRIBUTE SIMD"; break;
+    case EXEC_OMP_TEAMS_LOOP: name = "TEAMS LOOP"; break;
     case EXEC_OMP_WORKSHARE: name = "WORKSHARE"; break;
     default:
       gcc_unreachable ();
@@ -1977,10 +1995,12 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DISTRIBUTE_SIMD:
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
+    case EXEC_OMP_LOOP:
     case EXEC_OMP_ORDERED:
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_LOOP:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -1997,12 +2017,14 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_TARGET_PARALLEL:
     case EXEC_OMP_TARGET_PARALLEL_DO:
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
     case EXEC_OMP_TARGET_SIMD:
     case EXEC_OMP_TARGET_TEAMS:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
     case EXEC_OMP_TARGET_UPDATE:
     case EXEC_OMP_TASK:
     case EXEC_OMP_TASKLOOP:
@@ -2012,6 +2034,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TEAMS_LOOP:
     case EXEC_OMP_WORKSHARE:
       omp_clauses = c->ext.omp_clauses;
       break;
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index e3b1d15..34fb22c 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5542,6 +5542,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	    case EXEC_OMP_PARALLEL:
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_DO_SIMD:
+	    case EXEC_OMP_PARALLEL_LOOP:
 	    case EXEC_OMP_PARALLEL_MASTER:
 	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -5567,6 +5568,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	    case EXEC_OMP_DISTRIBUTE_SIMD:
 	    case EXEC_OMP_DO:
 	    case EXEC_OMP_DO_SIMD:
+	    case EXEC_OMP_LOOP:
 	    case EXEC_OMP_ORDERED:
 	    case EXEC_OMP_SECTIONS:
 	    case EXEC_OMP_SINGLE:
@@ -5581,12 +5583,14 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	    case EXEC_OMP_TARGET_PARALLEL:
 	    case EXEC_OMP_TARGET_PARALLEL_DO:
 	    case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+	    case EXEC_OMP_TARGET_PARALLEL_LOOP:
 	    case EXEC_OMP_TARGET_SIMD:
 	    case EXEC_OMP_TARGET_TEAMS:
 	    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
 	    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	    case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+	    case EXEC_OMP_TARGET_TEAMS_LOOP:
 	    case EXEC_OMP_TARGET_UPDATE:
 	    case EXEC_OMP_TASK:
 	    case EXEC_OMP_TEAMS:
@@ -5594,6 +5598,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	    case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	    case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	    case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+	    case EXEC_OMP_TEAMS_LOOP:
 
 	      /* Come to this label only from the
 		 EXEC_OMP_PARALLEL_* cases above.  */
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2020ab4..cbc95d3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -271,7 +271,11 @@ enum gfc_statement
   ST_OMP_END_PARALLEL_MASTER_TASKLOOP, ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD,
   ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD, ST_OMP_MASTER_TASKLOOP,
   ST_OMP_END_MASTER_TASKLOOP, ST_OMP_MASTER_TASKLOOP_SIMD,
-  ST_OMP_END_MASTER_TASKLOOP_SIMD, ST_NONE
+  ST_OMP_END_MASTER_TASKLOOP_SIMD, ST_OMP_LOOP, ST_OMP_END_LOOP,
+  ST_OMP_PARALLEL_LOOP, ST_OMP_END_PARALLEL_LOOP, ST_OMP_TEAMS_LOOP,
+  ST_OMP_END_TEAMS_LOOP, ST_OMP_TARGET_PARALLEL_LOOP,
+  ST_OMP_END_TARGET_PARALLEL_LOOP, ST_OMP_TARGET_TEAMS_LOOP,
+  ST_OMP_END_TARGET_TEAMS_LOOP, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -1401,6 +1405,14 @@ enum gfc_omp_memorder
   OMP_MEMORDER_RELAXED
 };
 
+enum gfc_omp_bind_type
+{
+  OMP_BIND_UNSET,
+  OMP_BIND_TEAMS,
+  OMP_BIND_PARALLEL,
+  OMP_BIND_THREAD
+};
+
 typedef struct gfc_omp_clauses
 {
   struct gfc_expr *if_expr;
@@ -1421,6 +1433,7 @@ typedef struct gfc_omp_clauses
   enum gfc_omp_cancel_kind cancel;
   enum gfc_omp_proc_bind_kind proc_bind;
   enum gfc_omp_depend_op depobj_update;
+  enum gfc_omp_bind_type bind;
   struct gfc_expr *safelen_expr;
   struct gfc_expr *simdlen_expr;
   struct gfc_expr *num_teams;
@@ -2717,7 +2730,8 @@ enum gfc_exec_op
   EXEC_OMP_TASKLOOP, EXEC_OMP_TASKLOOP_SIMD, EXEC_OMP_SCAN, EXEC_OMP_DEPOBJ,
   EXEC_OMP_PARALLEL_MASTER, EXEC_OMP_PARALLEL_MASTER_TASKLOOP,
   EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD, EXEC_OMP_MASTER_TASKLOOP,
-  EXEC_OMP_MASTER_TASKLOOP_SIMD
+  EXEC_OMP_MASTER_TASKLOOP_SIMD, EXEC_OMP_LOOP, EXEC_OMP_PARALLEL_LOOP,
+  EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP, EXEC_OMP_TARGET_TEAMS_LOOP
 };
 
 typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index bcedf8e..bb1f34f 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -167,6 +167,7 @@ match gfc_match_omp_distribute_parallel_do_simd (void);
 match gfc_match_omp_distribute_simd (void);
 match gfc_match_omp_do (void);
 match gfc_match_omp_do_simd (void);
+match gfc_match_omp_loop (void);
 match gfc_match_omp_flush (void);
 match gfc_match_omp_master (void);
 match gfc_match_omp_master_taskloop (void);
@@ -176,6 +177,7 @@ match gfc_match_omp_ordered_depend (void);
 match gfc_match_omp_parallel (void);
 match gfc_match_omp_parallel_do (void);
 match gfc_match_omp_parallel_do_simd (void);
+match gfc_match_omp_parallel_loop (void);
 match gfc_match_omp_parallel_master (void);
 match gfc_match_omp_parallel_master_taskloop (void);
 match gfc_match_omp_parallel_master_taskloop_simd (void);
@@ -193,12 +195,14 @@ match gfc_match_omp_target_exit_data (void);
 match gfc_match_omp_target_parallel (void);
 match gfc_match_omp_target_parallel_do (void);
 match gfc_match_omp_target_parallel_do_simd (void);
+match gfc_match_omp_target_parallel_loop (void);
 match gfc_match_omp_target_simd (void);
 match gfc_match_omp_target_teams (void);
 match gfc_match_omp_target_teams_distribute (void);
 match gfc_match_omp_target_teams_distribute_parallel_do (void);
 match gfc_match_omp_target_teams_distribute_parallel_do_simd (void);
 match gfc_match_omp_target_teams_distribute_simd (void);
+match gfc_match_omp_target_teams_loop (void);
 match gfc_match_omp_target_update (void);
 match gfc_match_omp_task (void);
 match gfc_match_omp_taskgroup (void);
@@ -211,6 +215,7 @@ match gfc_match_omp_teams_distribute (void);
 match gfc_match_omp_teams_distribute_parallel_do (void);
 match gfc_match_omp_teams_distribute_parallel_do_simd (void);
 match gfc_match_omp_teams_distribute_simd (void);
+match gfc_match_omp_teams_loop (void);
 match gfc_match_omp_threadprivate (void);
 match gfc_match_omp_workshare (void);
 match gfc_match_omp_end_critical (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 9dba165..d7136b1 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -846,6 +846,7 @@ enum omp_mask1
   OMP_CLAUSE_MEMORDER,  /* OpenMP 5.0.  */
   OMP_CLAUSE_DETACH,  /* OpenMP 5.0.  */
   OMP_CLAUSE_AFFINITY,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_BIND,  /* OpenMP 5.0.  */
   OMP_CLAUSE_NOWAIT,
   /* This must come last.  */
   OMP_MASK1_LAST
@@ -1426,6 +1427,26 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					   allow_derived))
 	    continue;
 	  break;
+	case 'b':
+	  if ((mask & OMP_CLAUSE_BIND)
+	      && c->bind == OMP_BIND_UNSET
+	      && gfc_match ("bind ( ") == MATCH_YES)
+	    {
+	      if (gfc_match ("teams )") == MATCH_YES)
+		c->bind = OMP_BIND_TEAMS;
+	      else if (gfc_match ("parallel )") == MATCH_YES)
+		c->bind = OMP_BIND_PARALLEL;
+	      else if (gfc_match ("thread )") == MATCH_YES)
+		c->bind = OMP_BIND_THREAD;
+	      else
+		{
+		  gfc_error ("Expected TEAMS, PARALLEL or THEAD as binding in "
+			     "BIND at %C");
+		  break;
+		}
+	      continue;
+	    }
+	  break;
 	case 'c':
 	  if ((mask & OMP_CLAUSE_CAPTURE)
 	      && !c->capture
@@ -3016,6 +3037,9 @@ cleanup:
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION			\
    | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE	\
    | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER)
+#define OMP_LOOP_CLAUSES \
+  (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER	\
+   | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
 #define OMP_SECTIONS_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
@@ -3255,6 +3279,45 @@ gfc_match_omp_do_simd (void)
 
 
 match
+gfc_match_omp_loop (void)
+{
+  return match_omp (EXEC_OMP_LOOP, OMP_LOOP_CLAUSES);
+}
+
+
+match
+gfc_match_omp_teams_loop (void)
+{
+  return match_omp (EXEC_OMP_TEAMS_LOOP, OMP_TEAMS_CLAUSES | OMP_LOOP_CLAUSES);
+}
+
+
+match
+gfc_match_omp_target_teams_loop (void)
+{
+  return match_omp (EXEC_OMP_TARGET_TEAMS_LOOP,
+		    OMP_TARGET_CLAUSES | OMP_TEAMS_CLAUSES | OMP_LOOP_CLAUSES);
+}
+
+
+match
+gfc_match_omp_parallel_loop (void)
+{
+  return match_omp (EXEC_OMP_PARALLEL_LOOP,
+		    OMP_PARALLEL_CLAUSES | OMP_LOOP_CLAUSES);
+}
+
+
+match
+gfc_match_omp_target_parallel_loop (void)
+{
+  return match_omp (EXEC_OMP_TARGET_PARALLEL_LOOP,
+		    (OMP_TARGET_CLAUSES | OMP_PARALLEL_CLAUSES
+		     | OMP_LOOP_CLAUSES));
+}
+
+
+match
 gfc_match_omp_flush (void)
 {
   gfc_omp_namelist *list = NULL;
@@ -5889,14 +5952,19 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 		  {
 		  case OMP_LIST_REDUCTION_TASK:
 		    if (code
-			&& (code->op == EXEC_OMP_TASKLOOP
+			&& (code->op == EXEC_OMP_LOOP
+			    || code->op == EXEC_OMP_TASKLOOP
 			    || code->op == EXEC_OMP_TASKLOOP_SIMD
 			    || code->op == EXEC_OMP_MASTER_TASKLOOP
 			    || code->op == EXEC_OMP_MASTER_TASKLOOP_SIMD
+			    || code->op == EXEC_OMP_PARALLEL_LOOP
 			    || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP
 			    || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
+			    || code->op == EXEC_OMP_TARGET_PARALLEL_LOOP
+			    || code->op == EXEC_OMP_TARGET_TEAMS_LOOP
 			    || code->op == EXEC_OMP_TEAMS
-			    || code->op == EXEC_OMP_TEAMS_DISTRIBUTE))
+			    || code->op == EXEC_OMP_TEAMS_DISTRIBUTE
+			    || code->op == EXEC_OMP_TEAMS_LOOP))
 		      {
 			gfc_error ("Only DEFAULT permitted as reduction-"
 				   "modifier in REDUCTION clause at %L",
@@ -6953,11 +7021,13 @@ resolve_omp_do (gfc_code *code)
       break;
     case EXEC_OMP_DO: name = "!$OMP DO"; break;
     case EXEC_OMP_DO_SIMD: name = "!$OMP DO SIMD"; is_simd = true; break;
+    case EXEC_OMP_LOOP: name = "!$OMP LOOP"; break;
     case EXEC_OMP_PARALLEL_DO: name = "!$OMP PARALLEL DO"; break;
     case EXEC_OMP_PARALLEL_DO_SIMD:
       name = "!$OMP PARALLEL DO SIMD";
       is_simd = true;
       break;
+    case EXEC_OMP_PARALLEL_LOOP: name = "!$OMP PARALLEL LOOP"; break;
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
       name = "!$OMP PARALLEL MASTER TASKLOOP";
       break;
@@ -6976,6 +7046,9 @@ resolve_omp_do (gfc_code *code)
       name = "!$OMP TARGET PARALLEL DO SIMD";
       is_simd = true;
       break;
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
+      name = "!$OMP TARGET PARALLEL LOOP";
+      break;
     case EXEC_OMP_TARGET_SIMD:
       name = "!$OMP TARGET SIMD";
       is_simd = true;
@@ -6994,6 +7067,7 @@ resolve_omp_do (gfc_code *code)
       name = "!$OMP TARGET TEAMS DISTRIBUTE SIMD";
       is_simd = true;
       break;
+    case EXEC_OMP_TARGET_TEAMS_LOOP: name = "!$OMP TARGET TEAMS LOOP"; break;
     case EXEC_OMP_TASKLOOP: name = "!$OMP TASKLOOP"; break;
     case EXEC_OMP_TASKLOOP_SIMD:
       name = "!$OMP TASKLOOP SIMD";
@@ -7011,6 +7085,7 @@ resolve_omp_do (gfc_code *code)
       name = "!$OMP TEAMS DISTRIBUTE SIMD";
       is_simd = true;
       break;
+    case EXEC_OMP_TEAMS_LOOP: name = "!$OMP TEAMS LOOP"; break;
     default: gcc_unreachable ();
     }
 
@@ -7152,6 +7227,8 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_PARALLEL_WORKSHARE;
     case EXEC_OMP_DO:
       return ST_OMP_DO;
+    case EXEC_OMP_LOOP:
+      return ST_OMP_LOOP;
     case EXEC_OMP_ATOMIC:
       return ST_OMP_ATOMIC;
     case EXEC_OMP_BARRIER:
@@ -7190,6 +7267,8 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_TARGET_PARALLEL_DO;
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
       return ST_OMP_TARGET_PARALLEL_DO_SIMD;
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
+      return ST_OMP_TARGET_PARALLEL_LOOP;
     case EXEC_OMP_TARGET_SIMD:
       return ST_OMP_TARGET_SIMD;
     case EXEC_OMP_TARGET_TEAMS:
@@ -7202,6 +7281,8 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
       return ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD;
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
+      return ST_OMP_TARGET_TEAMS_LOOP;
     case EXEC_OMP_TARGET_UPDATE:
       return ST_OMP_TARGET_UPDATE;
     case EXEC_OMP_TASKGROUP:
@@ -7224,10 +7305,14 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
       return ST_OMP_TEAMS_DISTRIBUTE_SIMD;
+    case EXEC_OMP_TEAMS_LOOP:
+      return ST_OMP_TEAMS_LOOP;
     case EXEC_OMP_PARALLEL_DO:
       return ST_OMP_PARALLEL_DO;
     case EXEC_OMP_PARALLEL_DO_SIMD:
       return ST_OMP_PARALLEL_DO_SIMD;
+    case EXEC_OMP_PARALLEL_LOOP:
+      return ST_OMP_PARALLEL_LOOP;
     case EXEC_OMP_DEPOBJ:
       return ST_OMP_DEPOBJ;
     default:
@@ -7628,8 +7713,10 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_DISTRIBUTE_SIMD:
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
+    case EXEC_OMP_LOOP:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_LOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_MASTER_TASKLOOP:
@@ -7637,17 +7724,20 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_SIMD:
     case EXEC_OMP_TARGET_PARALLEL_DO:
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
     case EXEC_OMP_TARGET_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
     case EXEC_OMP_TASKLOOP:
     case EXEC_OMP_TASKLOOP_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TEAMS_LOOP:
       resolve_omp_do (code);
       break;
     case EXEC_OMP_CANCEL:
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index c44e23c..0522b39 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -988,6 +988,9 @@ decode_omp_directive (void)
 	      ST_OMP_MASTER_TASKLOOP);
       matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
       break;
+    case 'l':
+      matcho ("loop", gfc_match_omp_loop, ST_OMP_LOOP);
+      break;
     case 'o':
       if (gfc_match ("ordered depend (") == MATCH_YES)
 	{
@@ -1004,6 +1007,8 @@ decode_omp_directive (void)
       matchs ("parallel do simd", gfc_match_omp_parallel_do_simd,
 	      ST_OMP_PARALLEL_DO_SIMD);
       matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
+      matcho ("parallel loop", gfc_match_omp_parallel_loop,
+	      ST_OMP_PARALLEL_LOOP);
       matcho ("parallel master taskloop simd",
 	      gfc_match_omp_parallel_master_taskloop_simd,
 	      ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD);
@@ -1037,6 +1042,8 @@ decode_omp_directive (void)
 	      ST_OMP_TARGET_PARALLEL_DO_SIMD);
       matcho ("target parallel do", gfc_match_omp_target_parallel_do,
 	      ST_OMP_TARGET_PARALLEL_DO);
+      matcho ("target parallel loop", gfc_match_omp_target_parallel_loop,
+	      ST_OMP_TARGET_PARALLEL_LOOP);
       matcho ("target parallel", gfc_match_omp_target_parallel,
 	      ST_OMP_TARGET_PARALLEL);
       matchs ("target simd", gfc_match_omp_target_simd, ST_OMP_TARGET_SIMD);
@@ -1051,6 +1058,8 @@ decode_omp_directive (void)
 	      ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD);
       matcho ("target teams distribute", gfc_match_omp_target_teams_distribute,
 	      ST_OMP_TARGET_TEAMS_DISTRIBUTE);
+      matcho ("target teams loop", gfc_match_omp_target_teams_loop,
+	      ST_OMP_TARGET_TEAMS_LOOP);
       matcho ("target teams", gfc_match_omp_target_teams, ST_OMP_TARGET_TEAMS);
       matcho ("target update", gfc_match_omp_target_update,
 	      ST_OMP_TARGET_UPDATE);
@@ -1072,6 +1081,7 @@ decode_omp_directive (void)
 	      ST_OMP_TEAMS_DISTRIBUTE_SIMD);
       matcho ("teams distribute", gfc_match_omp_teams_distribute,
 	      ST_OMP_TEAMS_DISTRIBUTE);
+      matcho ("teams loop", gfc_match_omp_teams_loop, ST_OMP_TEAMS_LOOP);
       matcho ("teams", gfc_match_omp_teams, ST_OMP_TEAMS);
       matchdo ("threadprivate", gfc_match_omp_threadprivate,
 	       ST_OMP_THREADPRIVATE);
@@ -1125,9 +1135,11 @@ decode_omp_directive (void)
     case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
     case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+    case ST_OMP_TARGET_TEAMS_LOOP:
     case ST_OMP_TARGET_PARALLEL:
     case ST_OMP_TARGET_PARALLEL_DO:
     case ST_OMP_TARGET_PARALLEL_DO_SIMD:
+    case ST_OMP_TARGET_PARALLEL_LOOP:
     case ST_OMP_TARGET_SIMD:
     case ST_OMP_TARGET_UPDATE:
       {
@@ -1650,6 +1662,8 @@ next_statement (void)
   case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: case ST_OMP_TARGET_PARALLEL: \
   case ST_OMP_TARGET_PARALLEL_DO: case ST_OMP_TARGET_PARALLEL_DO_SIMD: \
   case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \
+  case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP: \
+  case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP: \
   case ST_CRITICAL: \
   case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
   case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \
@@ -2359,6 +2373,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_SIMD:
       p = "!$OMP END SIMD";
       break;
+    case ST_OMP_END_LOOP:
+      p = "!$OMP END LOOP";
+      break;
     case ST_OMP_END_MASTER:
       p = "!$OMP END MASTER";
       break;
@@ -2380,6 +2397,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_PARALLEL_DO_SIMD:
       p = "!$OMP END PARALLEL DO SIMD";
       break;
+    case ST_OMP_END_PARALLEL_LOOP:
+      p = "!$OMP END PARALLEL LOOP";
+      break;
     case ST_OMP_END_PARALLEL_MASTER:
       p = "!$OMP END PARALLEL MASTER";
       break;
@@ -2419,6 +2439,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_TARGET_PARALLEL_DO_SIMD:
       p = "!$OMP END TARGET PARALLEL DO SIMD";
       break;
+    case ST_OMP_END_TARGET_PARALLEL_LOOP:
+      p = "!$OMP END TARGET PARALLEL LOOP";
+      break;
     case ST_OMP_END_TARGET_SIMD:
       p = "!$OMP END TARGET SIMD";
       break;
@@ -2437,6 +2460,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD:
       p = "!$OMP END TARGET TEAMS DISTRIBUTE SIMD";
       break;
+    case ST_OMP_END_TARGET_TEAMS_LOOP:
+      p = "!$OMP END TARGET TEAMS LOOP";
+      break;
     case ST_OMP_END_TASKGROUP:
       p = "!$OMP END TASKGROUP";
       break;
@@ -2461,12 +2487,18 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_TEAMS_DISTRIBUTE_SIMD:
       p = "!$OMP END TEAMS DISTRIBUTE SIMD";
       break;
+    case ST_OMP_END_TEAMS_LOOP:
+      p = "!$OMP END TEAMS LOP";
+      break;
     case ST_OMP_END_WORKSHARE:
       p = "!$OMP END WORKSHARE";
       break;
     case ST_OMP_FLUSH:
       p = "!$OMP FLUSH";
       break;
+    case ST_OMP_LOOP:
+      p = "!$OMP LOOP";
+      break;
     case ST_OMP_MASTER:
       p = "!$OMP MASTER";
       break;
@@ -2486,6 +2518,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_PARALLEL_DO:
       p = "!$OMP PARALLEL DO";
       break;
+    case ST_OMP_PARALLEL_LOOP:
+      p = "!$OMP PARALLEL LOOP";
+      break;
     case ST_OMP_PARALLEL_DO_SIMD:
       p = "!$OMP PARALLEL DO SIMD";
       break;
@@ -2543,6 +2578,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_TARGET_PARALLEL_DO_SIMD:
       p = "!$OMP TARGET PARALLEL DO SIMD";
       break;
+    case ST_OMP_TARGET_PARALLEL_LOOP:
+      p = "!$OMP TARGET PARALLEL LOOP";
+      break;
     case ST_OMP_TARGET_SIMD:
       p = "!$OMP TARGET SIMD";
       break;
@@ -2561,6 +2599,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
       p = "!$OMP TARGET TEAMS DISTRIBUTE SIMD";
       break;
+    case ST_OMP_TARGET_TEAMS_LOOP:
+      p = "!$OMP TARGET TEAMS LOOP";
+      break;
     case ST_OMP_TARGET_UPDATE:
       p = "!$OMP TARGET UPDATE";
       break;
@@ -2597,6 +2638,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
       p = "!$OMP TEAMS DISTRIBUTE SIMD";
       break;
+    case ST_OMP_TEAMS_LOOP:
+      p = "!$OMP TEAMS LOOP";
+      break;
     case ST_OMP_THREADPRIVATE:
       p = "!$OMP THREADPRIVATE";
       break;
@@ -5044,10 +5088,14 @@ parse_omp_do (gfc_statement omp_st)
       break;
     case ST_OMP_DO: omp_end_st = ST_OMP_END_DO; break;
     case ST_OMP_DO_SIMD: omp_end_st = ST_OMP_END_DO_SIMD; break;
+    case ST_OMP_LOOP: omp_end_st = ST_OMP_END_LOOP; break;
     case ST_OMP_PARALLEL_DO: omp_end_st = ST_OMP_END_PARALLEL_DO; break;
     case ST_OMP_PARALLEL_DO_SIMD:
       omp_end_st = ST_OMP_END_PARALLEL_DO_SIMD;
       break;
+    case ST_OMP_PARALLEL_LOOP:
+      omp_end_st = ST_OMP_END_PARALLEL_LOOP;
+      break;
     case ST_OMP_SIMD: omp_end_st = ST_OMP_END_SIMD; break;
     case ST_OMP_TARGET_PARALLEL_DO:
       omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO;
@@ -5055,6 +5103,9 @@ parse_omp_do (gfc_statement omp_st)
     case ST_OMP_TARGET_PARALLEL_DO_SIMD:
       omp_end_st = ST_OMP_END_TARGET_PARALLEL_DO_SIMD;
       break;
+    case ST_OMP_TARGET_PARALLEL_LOOP:
+      omp_end_st = ST_OMP_END_TARGET_PARALLEL_LOOP;
+      break;
     case ST_OMP_TARGET_SIMD: omp_end_st = ST_OMP_END_TARGET_SIMD; break;
     case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
       omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE;
@@ -5068,6 +5119,9 @@ parse_omp_do (gfc_statement omp_st)
     case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
       omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD;
       break;
+    case ST_OMP_TARGET_TEAMS_LOOP:
+      omp_end_st = ST_OMP_END_TARGET_TEAMS_LOOP;
+      break;
     case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break;
     case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break;
     case ST_OMP_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_MASTER_TASKLOOP; break;
@@ -5092,6 +5146,9 @@ parse_omp_do (gfc_statement omp_st)
     case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
       omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
       break;
+    case ST_OMP_TEAMS_LOOP:
+      omp_end_st = ST_OMP_END_TEAMS_LOOP;
+      break;
     default: gcc_unreachable ();
     }
   if (st == omp_end_st)
@@ -5323,12 +5380,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_PARALLEL_MASTER:
       omp_end_st = ST_OMP_END_PARALLEL_MASTER;
       break;
-    case ST_OMP_PARALLEL_MASTER_TASKLOOP:
-      omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
-      break;
-    case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
-      omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
-      break;
     case ST_OMP_PARALLEL_SECTIONS:
       omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
       break;
@@ -5344,12 +5395,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_MASTER:
       omp_end_st = ST_OMP_END_MASTER;
       break;
-    case ST_OMP_MASTER_TASKLOOP:
-      omp_end_st = ST_OMP_END_MASTER_TASKLOOP;
-      break;
-    case ST_OMP_MASTER_TASKLOOP_SIMD:
-      omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD;
-      break;
     case ST_OMP_SINGLE:
       omp_end_st = ST_OMP_END_SINGLE;
       break;
@@ -5365,18 +5410,6 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_TARGET_TEAMS:
       omp_end_st = ST_OMP_END_TARGET_TEAMS;
       break;
-    case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
-      omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE;
-      break;
-    case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
-      omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO;
-      break;
-    case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
-      omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
-      break;
-    case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
-      omp_end_st = ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD;
-      break;
     case ST_OMP_TASK:
       omp_end_st = ST_OMP_END_TASK;
       break;
@@ -5389,27 +5422,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_TEAMS_DISTRIBUTE:
       omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
       break;
-    case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
-      omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO;
-      break;
-    case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
-      omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
-      break;
-    case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
-      omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
-      break;
     case ST_OMP_DISTRIBUTE:
       omp_end_st = ST_OMP_END_DISTRIBUTE;
       break;
-    case ST_OMP_DISTRIBUTE_PARALLEL_DO:
-      omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO;
-      break;
-    case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
-      omp_end_st = ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD;
-      break;
-    case ST_OMP_DISTRIBUTE_SIMD:
-      omp_end_st = ST_OMP_END_DISTRIBUTE_SIMD;
-      break;
     case ST_OMP_WORKSHARE:
       omp_end_st = ST_OMP_END_WORKSHARE;
       break;
@@ -5689,8 +5704,10 @@ parse_executable (gfc_statement st)
 	case ST_OMP_DISTRIBUTE_SIMD:
 	case ST_OMP_DO:
 	case ST_OMP_DO_SIMD:
+	case ST_OMP_LOOP:
 	case ST_OMP_PARALLEL_DO:
 	case ST_OMP_PARALLEL_DO_SIMD:
+	case ST_OMP_PARALLEL_LOOP:
 	case ST_OMP_PARALLEL_MASTER_TASKLOOP:
 	case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
 	case ST_OMP_MASTER_TASKLOOP:
@@ -5698,17 +5715,20 @@ parse_executable (gfc_statement st)
 	case ST_OMP_SIMD:
 	case ST_OMP_TARGET_PARALLEL_DO:
 	case ST_OMP_TARGET_PARALLEL_DO_SIMD:
+	case ST_OMP_TARGET_PARALLEL_LOOP:
 	case ST_OMP_TARGET_SIMD:
 	case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
 	case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+	case ST_OMP_TARGET_TEAMS_LOOP:
 	case ST_OMP_TASKLOOP:
 	case ST_OMP_TASKLOOP_SIMD:
 	case ST_OMP_TEAMS_DISTRIBUTE:
 	case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
+	case ST_OMP_TEAMS_LOOP:
 	  st = parse_omp_do (st);
 	  if (st == ST_IMPLIED_ENDDO)
 	    return st;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index fed6dce..a37ad66 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10797,6 +10797,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_DISTRIBUTE_SIMD:
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
+	case EXEC_OMP_LOOP:
 	case EXEC_OMP_MASTER:
 	case EXEC_OMP_MASTER_TASKLOOP:
 	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
@@ -10804,6 +10805,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
+	case EXEC_OMP_PARALLEL_LOOP:
 	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -10819,12 +10821,14 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_TARGET_PARALLEL:
 	case EXEC_OMP_TARGET_PARALLEL_DO:
 	case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+	case EXEC_OMP_TARGET_PARALLEL_LOOP:
 	case EXEC_OMP_TARGET_SIMD:
 	case EXEC_OMP_TARGET_TEAMS:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+	case EXEC_OMP_TARGET_TEAMS_LOOP:
 	case EXEC_OMP_TARGET_UPDATE:
 	case EXEC_OMP_TASK:
 	case EXEC_OMP_TASKGROUP:
@@ -10836,6 +10840,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_TEAMS_DISTRIBUTE:
 	case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+	case EXEC_OMP_TEAMS_LOOP:
 	case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
 	case EXEC_OMP_WORKSHARE:
 	  break;
@@ -12219,6 +12224,7 @@ start:
 	case EXEC_OMP_DISTRIBUTE_SIMD:
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
+	case EXEC_OMP_LOOP:
 	case EXEC_OMP_MASTER:
 	case EXEC_OMP_MASTER_TASKLOOP:
 	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
@@ -12234,12 +12240,14 @@ start:
 	case EXEC_OMP_TARGET_PARALLEL:
 	case EXEC_OMP_TARGET_PARALLEL_DO:
 	case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+	case EXEC_OMP_TARGET_PARALLEL_LOOP:
 	case EXEC_OMP_TARGET_SIMD:
 	case EXEC_OMP_TARGET_TEAMS:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+	case EXEC_OMP_TARGET_TEAMS_LOOP:
 	case EXEC_OMP_TARGET_UPDATE:
 	case EXEC_OMP_TASK:
 	case EXEC_OMP_TASKGROUP:
@@ -12252,6 +12260,7 @@ start:
 	case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+	case EXEC_OMP_TEAMS_LOOP:
 	case EXEC_OMP_WORKSHARE:
 	  gfc_resolve_omp_directive (code, ns);
 	  break;
@@ -12259,6 +12268,7 @@ start:
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
+	case EXEC_OMP_PARALLEL_LOOP:
 	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 9f6fe49..6ae1df6 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -225,6 +225,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_DISTRIBUTE_SIMD:
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
+    case EXEC_OMP_LOOP:
     case EXEC_OMP_END_SINGLE:
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
@@ -232,6 +233,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_LOOP:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -248,12 +250,14 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_TARGET_PARALLEL:
     case EXEC_OMP_TARGET_PARALLEL_DO:
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
     case EXEC_OMP_TARGET_SIMD:
     case EXEC_OMP_TARGET_TEAMS:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
     case EXEC_OMP_TARGET_UPDATE:
     case EXEC_OMP_TASK:
     case EXEC_OMP_TASKLOOP:
@@ -263,6 +267,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TEAMS_LOOP:
     case EXEC_OMP_WORKSHARE:
       gfc_free_omp_clauses (p->ext.omp_clauses);
       break;
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 2917d3d..1e22cdb 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4195,6 +4195,25 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	  OMP_CLAUSE_GANG_STATIC_EXPR (c) = arg;
 	}
     }
+  if (clauses->bind != OMP_BIND_UNSET)
+    {
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_BIND);
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+      switch (clauses->bind)
+	{
+	case OMP_BIND_TEAMS:
+	  OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_TEAMS;
+	  break;
+	case OMP_BIND_PARALLEL:
+	  OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_PARALLEL;
+	  break;
+	case OMP_BIND_THREAD:
+	  OMP_CLAUSE_BIND_KIND (c) = OMP_CLAUSE_BIND_THREAD;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+    }
 
   return nreverse (omp_clauses);
 }
@@ -5083,6 +5102,7 @@ gfc_trans_omp_do (gfc_code *code, gfc_exec_op op, stmtblock_t *pblock,
     case EXEC_OMP_SIMD: stmt = make_node (OMP_SIMD); break;
     case EXEC_OMP_DO: stmt = make_node (OMP_FOR); break;
     case EXEC_OMP_DISTRIBUTE: stmt = make_node (OMP_DISTRIBUTE); break;
+    case EXEC_OMP_LOOP: stmt = make_node (OMP_LOOP); break;
     case EXEC_OMP_TASKLOOP: stmt = make_node (OMP_TASKLOOP); break;
     case EXEC_OACC_LOOP: stmt = make_node (OACC_LOOP); break;
     default: gcc_unreachable ();
@@ -5343,6 +5363,7 @@ gfc_split_omp_clauses (gfc_code *code,
 		       gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
 {
   int mask = 0, innermost = 0;
+  bool is_loop = false;
   memset (clausesa, 0, GFC_OMP_SPLIT_NUM * sizeof (gfc_omp_clauses));
   switch (code->op)
     {
@@ -5363,6 +5384,7 @@ gfc_split_omp_clauses (gfc_code *code,
       innermost = GFC_OMP_SPLIT_SIMD;
       break;
     case EXEC_OMP_DO:
+    case EXEC_OMP_LOOP:
       innermost = GFC_OMP_SPLIT_DO;
       break;
     case EXEC_OMP_DO_SIMD:
@@ -5373,6 +5395,7 @@ gfc_split_omp_clauses (gfc_code *code,
       innermost = GFC_OMP_SPLIT_PARALLEL;
       break;
     case EXEC_OMP_PARALLEL_DO:
+    case EXEC_OMP_PARALLEL_LOOP:
       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
       innermost = GFC_OMP_SPLIT_DO;
       break;
@@ -5399,6 +5422,7 @@ gfc_split_omp_clauses (gfc_code *code,
       innermost = GFC_OMP_SPLIT_PARALLEL;
       break;
     case EXEC_OMP_TARGET_PARALLEL_DO:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO;
       innermost = GFC_OMP_SPLIT_DO;
       break;
@@ -5435,6 +5459,10 @@ gfc_split_omp_clauses (gfc_code *code,
 	     | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_SIMD;
       break;
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
+      mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
+      innermost = GFC_OMP_SPLIT_DO;
+      break;
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_TASKLOOP:
       innermost = GFC_OMP_SPLIT_TASKLOOP;
@@ -5465,6 +5493,10 @@ gfc_split_omp_clauses (gfc_code *code,
       mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DISTRIBUTE | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_SIMD;
       break;
+    case EXEC_OMP_TEAMS_LOOP:
+      mask = GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
+      innermost = GFC_OMP_SPLIT_DO;
+      break;
     default:
       gcc_unreachable ();
     }
@@ -5473,6 +5505,18 @@ gfc_split_omp_clauses (gfc_code *code,
       clausesa[innermost] = *code->ext.omp_clauses;
       return;
     }
+  /* Loops are similar to DO but still a bit different.  */
+  switch (code->op)
+    {
+    case EXEC_OMP_LOOP:
+    case EXEC_OMP_PARALLEL_LOOP:
+    case EXEC_OMP_TEAMS_LOOP:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
+      is_loop = true;
+    default:
+      break;
+    }
   if (code->ext.omp_clauses != NULL)
     {
       if (mask & GFC_OMP_MASK_TARGET)
@@ -5540,7 +5584,7 @@ gfc_split_omp_clauses (gfc_code *code,
 	  clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
 	    = code->ext.omp_clauses->if_expr;
 	}
-      if (mask & GFC_OMP_MASK_DO)
+      if ((mask & GFC_OMP_MASK_DO) && !is_loop)
 	{
 	  /* First the clauses that are unique to some constructs.  */
 	  clausesa[GFC_OMP_SPLIT_DO].ordered
@@ -5560,6 +5604,11 @@ gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->chunk_size;
 	  clausesa[GFC_OMP_SPLIT_DO].nowait
 	    = code->ext.omp_clauses->nowait;
+	}
+      if (mask & GFC_OMP_MASK_DO)
+	{
+	  clausesa[GFC_OMP_SPLIT_DO].bind
+	    = code->ext.omp_clauses->bind;
 	  /* Duplicate collapse.  */
 	  clausesa[GFC_OMP_SPLIT_DO].collapse
 	    = code->ext.omp_clauses->collapse;
@@ -5621,7 +5670,7 @@ gfc_split_omp_clauses (gfc_code *code,
 	 it is enough to put it on the innermost one.  For
 	 !$ omp parallel do put it on parallel though,
 	 as that's what we did for OpenMP 3.1.  */
-      clausesa[innermost == GFC_OMP_SPLIT_DO
+      clausesa[innermost == GFC_OMP_SPLIT_DO && !is_loop
 	       ? (int) GFC_OMP_SPLIT_PARALLEL
 	       : innermost].lists[OMP_LIST_PRIVATE]
 	= code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
@@ -5637,19 +5686,25 @@ gfc_split_omp_clauses (gfc_code *code,
       else if (mask & GFC_OMP_MASK_DISTRIBUTE)
 	clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_FIRSTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
+      if (mask & GFC_OMP_MASK_TASKLOOP)
+	clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE]
+	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
       if (mask & GFC_OMP_MASK_PARALLEL)
 	clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
-      else if (mask & GFC_OMP_MASK_DO)
+      else if ((mask & GFC_OMP_MASK_DO) && !is_loop)
 	clausesa[GFC_OMP_SPLIT_DO].lists[OMP_LIST_FIRSTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
-      /* Lastprivate is allowed on distribute, do and simd.
+      /* Lastprivate is allowed on distribute, do, simd, taskloop and loop.
          In parallel do{, simd} we actually want to put it on
 	 parallel rather than do.  */
       if (mask & GFC_OMP_MASK_DISTRIBUTE)
 	clausesa[GFC_OMP_SPLIT_DISTRIBUTE].lists[OMP_LIST_LASTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
-      if (mask & GFC_OMP_MASK_PARALLEL)
+      if (mask & GFC_OMP_MASK_TASKLOOP)
+	clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE]
+	  = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
+      if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop)
 	clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
       else if (mask & GFC_OMP_MASK_DO)
@@ -5658,17 +5713,25 @@ gfc_split_omp_clauses (gfc_code *code,
       if (mask & GFC_OMP_MASK_SIMD)
 	clausesa[GFC_OMP_SPLIT_SIMD].lists[OMP_LIST_LASTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
-      /* Reduction is allowed on simd, do, parallel and teams.
-	 Duplicate it on all of them, but omit on do if
-	 parallel is present; additionally, inscan applies to do/simd only.  */
+      /* Reduction is allowed on simd, do, parallel, teams, taskloop, and loop.
+	 Duplicate it on all of them, but
+	 - omit on do if parallel is present;
+	 - omit on task and parallel if loop is present;
+	 additionally, inscan applies to do/simd only.  */
       for (int i = OMP_LIST_REDUCTION; i <= OMP_LIST_REDUCTION_TASK; i++)
 	{
-	  if (mask & GFC_OMP_MASK_TEAMS
+	  if (mask & GFC_OMP_MASK_TASKLOOP
 	      && i != OMP_LIST_REDUCTION_INSCAN)
+	    clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[i]
+	      = code->ext.omp_clauses->lists[i];
+	  if (mask & GFC_OMP_MASK_TEAMS
+	      && i != OMP_LIST_REDUCTION_INSCAN
+	      && !is_loop)
 	    clausesa[GFC_OMP_SPLIT_TEAMS].lists[i]
 	      = code->ext.omp_clauses->lists[i];
 	  if (mask & GFC_OMP_MASK_PARALLEL
-	      && i != OMP_LIST_REDUCTION_INSCAN)
+	      && i != OMP_LIST_REDUCTION_INSCAN
+	      && !is_loop)
 	    clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
 	      = code->ext.omp_clauses->lists[i];
 	  else if (mask & GFC_OMP_MASK_DO)
@@ -5689,8 +5752,9 @@ gfc_split_omp_clauses (gfc_code *code,
       clausesa[innermost].lists[OMP_LIST_LINEAR]
 	= code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
     }
-  if ((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
-      == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
+   if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
+	== (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
+       && !is_loop)
     clausesa[GFC_OMP_SPLIT_DO].nowait = true;
 }
 
@@ -5740,7 +5804,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
 }
 
 static tree
-gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
+gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
 			   gfc_omp_clauses *clausesa)
 {
   stmtblock_t block, *new_pblock = pblock;
@@ -5768,8 +5832,9 @@ gfc_trans_omp_parallel_do (gfc_code *code, stmtblock_t *pblock,
       else
 	pushlevel ();
     }
-  stmt = gfc_trans_omp_do (code, EXEC_OMP_DO, new_pblock,
-			   &clausesa[GFC_OMP_SPLIT_DO], omp_clauses);
+  stmt = gfc_trans_omp_do (code, is_loop ? EXEC_OMP_LOOP : EXEC_OMP_DO,
+			   new_pblock, &clausesa[GFC_OMP_SPLIT_DO],
+			   omp_clauses);
   if (pblock == NULL)
     {
       if (TREE_CODE (stmt) != BIND_EXPR)
@@ -6006,7 +6071,7 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
-      stmt = gfc_trans_omp_parallel_do (code, &block, clausesa);
+      stmt = gfc_trans_omp_parallel_do (code, false, &block, clausesa);
       if (TREE_CODE (stmt) != BIND_EXPR)
 	stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
       else
@@ -6083,6 +6148,12 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
 			       &clausesa[GFC_OMP_SPLIT_DISTRIBUTE],
 			       NULL);
       break;
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
+    case EXEC_OMP_TEAMS_LOOP:
+      stmt = gfc_trans_omp_do (code, EXEC_OMP_LOOP, NULL,
+			       &clausesa[GFC_OMP_SPLIT_DO],
+			       NULL);
+      break;
     default:
       stmt = gfc_trans_omp_distribute (code, clausesa);
       break;
@@ -6140,7 +6211,11 @@ gfc_trans_omp_target (gfc_code *code)
       }
       break;
     case EXEC_OMP_TARGET_PARALLEL_DO:
-      stmt = gfc_trans_omp_parallel_do (code, &block, clausesa);
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
+      stmt = gfc_trans_omp_parallel_do (code,
+					(code->op
+					 == EXEC_OMP_TARGET_PARALLEL_LOOP),
+					&block, clausesa);
       if (TREE_CODE (stmt) != BIND_EXPR)
 	stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
       else
@@ -6611,6 +6686,7 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_depobj (code);
     case EXEC_OMP_DISTRIBUTE:
     case EXEC_OMP_DO:
+    case EXEC_OMP_LOOP:
     case EXEC_OMP_SIMD:
     case EXEC_OMP_TASKLOOP:
       return gfc_trans_omp_do (code, code->op, NULL, code->ext.omp_clauses,
@@ -6633,7 +6709,9 @@ gfc_trans_omp_directive (gfc_code *code)
     case EXEC_OMP_PARALLEL:
       return gfc_trans_omp_parallel (code);
     case EXEC_OMP_PARALLEL_DO:
-      return gfc_trans_omp_parallel_do (code, NULL, NULL);
+      return gfc_trans_omp_parallel_do (code, false, NULL, NULL);
+    case EXEC_OMP_PARALLEL_LOOP:
+      return gfc_trans_omp_parallel_do (code, true, NULL, NULL);
     case EXEC_OMP_PARALLEL_DO_SIMD:
       return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
     case EXEC_OMP_PARALLEL_MASTER:
@@ -6652,12 +6730,14 @@ gfc_trans_omp_directive (gfc_code *code)
     case EXEC_OMP_TARGET_PARALLEL:
     case EXEC_OMP_TARGET_PARALLEL_DO:
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
     case EXEC_OMP_TARGET_SIMD:
     case EXEC_OMP_TARGET_TEAMS:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
       return gfc_trans_omp_target (code);
     case EXEC_OMP_TARGET_DATA:
       return gfc_trans_omp_target_data (code);
@@ -6682,6 +6762,7 @@ gfc_trans_omp_directive (gfc_code *code)
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TEAMS_LOOP:
       return gfc_trans_omp_teams (code, NULL, NULL_TREE);
     case EXEC_OMP_WORKSHARE:
       return gfc_trans_omp_workshare (code, code->ext.omp_clauses);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index cbbfcd9..3ffa394 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2168,6 +2168,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_DISTRIBUTE_SIMD:
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
+	case EXEC_OMP_LOOP:
 	case EXEC_OMP_FLUSH:
 	case EXEC_OMP_MASTER:
 	case EXEC_OMP_MASTER_TASKLOOP:
@@ -2176,6 +2177,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
+	case EXEC_OMP_PARALLEL_LOOP:
 	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -2191,12 +2193,14 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_TARGET_PARALLEL:
 	case EXEC_OMP_TARGET_PARALLEL_DO:
 	case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+	case EXEC_OMP_TARGET_PARALLEL_LOOP:
 	case EXEC_OMP_TARGET_SIMD:
 	case EXEC_OMP_TARGET_TEAMS:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+	case EXEC_OMP_TARGET_TEAMS_LOOP:
 	case EXEC_OMP_TARGET_UPDATE:
 	case EXEC_OMP_TASK:
 	case EXEC_OMP_TASKGROUP:
@@ -2209,6 +2213,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
 	case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
 	case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+	case EXEC_OMP_TEAMS_LOOP:
 	case EXEC_OMP_WORKSHARE:
 	  res = gfc_trans_omp_directive (code);
 	  break;
-- 
cgit v1.1


From 848a36032c8876ee45d5c81efeddb1bc657ac95c Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 4 Jun 2021 12:14:14 +0200
Subject: Fortran/OpenMP: omp loop's BIND clause - fix typo

Missed a 'git add' after fixing this typo pointed out during review.

	PR middle-end/99928

gcc/fortran/ChangeLog:

	* openmp.c (gfc_match_omp_clauses): Fix typo in error message.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/loop-2.f90: Update for typo fix.
---
 gcc/fortran/openmp.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index d7136b1..638a823 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1440,7 +1440,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		c->bind = OMP_BIND_THREAD;
 	      else
 		{
-		  gfc_error ("Expected TEAMS, PARALLEL or THEAD as binding in "
+		  gfc_error ("Expected TEAMS, PARALLEL or THREAD as binding in "
 			     "BIND at %C");
 		  break;
 		}
-- 
cgit v1.1


From 4facf2bf5b7b32f444da864306b5c11e14c15bcf Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 4 Jun 2021 17:43:59 +0200
Subject: Fortran: Fix OpenMP/OpenACC continue-line parsing

gcc/fortran/ChangeLog:

	* scanner.c (skip_fixed_omp_sentinel): Set openacc_flag if
	this is not an (OpenMP) continuation line.
	(skip_fixed_oacc_sentinel): Likewise for openmp_flag and OpenACC.
	(gfc_next_char_literal): gfc_error_now to force error for mixed OMP/ACC
	continuation once per location and return '\n'.

gcc/testsuite/ChangeLog:

	* gfortran.dg/goacc/omp-fixed.f: Re-add test item changed in previous
	commit in addition - add more dg-errors and '... end ...' due to changed
	parsing.
	* gfortran.dg/goacc/omp.f95: Likewise.
	* gfortran.dg/goacc-gomp/mixed-1.f: New test.
---
 gcc/fortran/scanner.c | 35 +++++++++++++++++++++++------------
 1 file changed, 23 insertions(+), 12 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.c
index 74c5461..39db099 100644
--- a/gcc/fortran/scanner.c
+++ b/gcc/fortran/scanner.c
@@ -942,6 +942,8 @@ skip_fixed_omp_sentinel (locus *start)
 	  && (continue_flag
 	      || c == ' ' || c == '\t' || c == '0'))
 	{
+	  if (c == ' ' || c == '\t' || c == '0')
+	    openacc_flag = 0;
 	  do
 	    c = next_char ();
 	  while (gfc_is_whitespace (c));
@@ -971,6 +973,8 @@ skip_fixed_oacc_sentinel (locus *start)
 	  && (continue_flag
 	      || c == ' ' || c == '\t' || c == '0'))
 	{
+	  if (c == ' ' || c == '\t' || c == '0')
+	    openmp_flag = 0;
 	  do
 	    c = next_char ();
 	  while (gfc_is_whitespace (c));
@@ -1205,6 +1209,7 @@ gfc_skip_comments (void)
 gfc_char_t
 gfc_next_char_literal (gfc_instring in_string)
 {
+  static locus omp_acc_err_loc = {};
   locus old_loc;
   int i, prev_openmp_flag, prev_openacc_flag;
   gfc_char_t c;
@@ -1403,14 +1408,16 @@ restart:
 	    {
 	      if (gfc_wide_tolower (c) != (unsigned char) "!$acc"[i])
 		is_openmp = 1;
-	      if (i == 4)
-		old_loc = gfc_current_locus;
 	    }
-	  gfc_error (is_openmp
-		     ? G_("Wrong OpenACC continuation at %C: "
-			  "expected !$ACC, got !$OMP")
-		     : G_("Wrong OpenMP continuation at %C: "
-			  "expected !$OMP, got !$ACC"));
+	  if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
+	      || omp_acc_err_loc.lb != gfc_current_locus.lb)
+	    gfc_error_now (is_openmp
+			   ? G_("Wrong OpenACC continuation at %C: "
+				"expected !$ACC, got !$OMP")
+			   : G_("Wrong OpenMP continuation at %C: "
+				"expected !$OMP, got !$ACC"));
+	  omp_acc_err_loc = gfc_current_locus;
+	  goto not_continuation;
 	}
 
       if (c != '&')
@@ -1511,11 +1518,15 @@ restart:
 	      if (gfc_wide_tolower (c) != (unsigned char) "*$acc"[i])
 		is_openmp = 1;
 	    }
-	  gfc_error (is_openmp
-		     ? G_("Wrong OpenACC continuation at %C: "
-			  "expected !$ACC, got !$OMP")
-		     : G_("Wrong OpenMP continuation at %C: "
-			  "expected !$OMP, got !$ACC"));
+	  if (omp_acc_err_loc.nextc != gfc_current_locus.nextc
+	      || omp_acc_err_loc.lb != gfc_current_locus.lb)
+	    gfc_error_now (is_openmp
+			   ? G_("Wrong OpenACC continuation at %C: "
+				"expected !$ACC, got !$OMP")
+			   : G_("Wrong OpenMP continuation at %C: "
+				"expected !$OMP, got !$ACC"));
+	  omp_acc_err_loc = gfc_current_locus;
+	  goto not_continuation;
 	}
       else if (!openmp_flag && !openacc_flag)
 	for (i = 0; i < 5; i++)
-- 
cgit v1.1


From cb6e6d5faa3f817435b6f203226fa5969d7a7264 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 4 Jun 2021 18:51:35 +0200
Subject: Fortran/OpenMP: Fix -fdump-parse-tree for 'omp loop'

gcc/fortran/ChangeLog
	* dump-parse-tree.c (show_code_node): Handle
	EXEC_OMP_(TARGET_)(,PARALLEL_,TEAMS_)LOOP.
---
 gcc/fortran/dump-parse-tree.c | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 8e2df73..141101e 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -3214,6 +3214,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_FLUSH:
+    case EXEC_OMP_LOOP:
     case EXEC_OMP_MASTER:
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
@@ -3221,6 +3222,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_LOOP:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -3237,12 +3239,14 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_TARGET_PARALLEL:
     case EXEC_OMP_TARGET_PARALLEL_DO:
     case EXEC_OMP_TARGET_PARALLEL_DO_SIMD:
+    case EXEC_OMP_TARGET_PARALLEL_LOOP:
     case EXEC_OMP_TARGET_SIMD:
     case EXEC_OMP_TARGET_TEAMS:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TARGET_TEAMS_LOOP:
     case EXEC_OMP_TARGET_UPDATE:
     case EXEC_OMP_TASK:
     case EXEC_OMP_TASKGROUP:
@@ -3255,6 +3259,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
     case EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_TEAMS_DISTRIBUTE_SIMD:
+    case EXEC_OMP_TEAMS_LOOP:
     case EXEC_OMP_WORKSHARE:
       show_omp_node (level, c);
       break;
-- 
cgit v1.1


From bee8619ad0ac3bd27b7c8dc5819b83a5e8e147a0 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 4 Jun 2021 19:23:48 +0200
Subject: Fortran - ICE in inline_matmul_assign

Restrict inlining of matmul to those cases where assignment to the
result array does not need special treatment.

gcc/fortran/ChangeLog:

	PR fortran/99839
	* frontend-passes.c (inline_matmul_assign): Do not inline matmul
	if the assignment to the resulting array if it is not of canonical
	type (real/integer/complex/logical).

gcc/testsuite/ChangeLog:

	PR fortran/99839
	* gfortran.dg/inline_matmul_25.f90: New test.
---
 gcc/fortran/frontend-passes.c | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 34fb22c..72a4e04 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -4193,6 +4193,19 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
   if (m_case == none)
     return 0;
 
+  /* We only handle assignment to numeric or logical variables.  */
+  switch(expr1->ts.type)
+    {
+    case BT_INTEGER:
+    case BT_LOGICAL:
+    case BT_REAL:
+    case BT_COMPLEX:
+      break;
+
+    default:
+      return 0;
+    }
+
   ns = insert_block ();
 
   /* Assign the type of the zero expression for initializing the resulting
-- 
cgit v1.1


From 600f90cbbbf2f1e4511d72a23a5d637d11e9f28b Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 5 Jun 2021 00:16:29 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 59 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 59 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bab25eb..33ab58a 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,62 @@
+2021-06-04  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/99839
+	* frontend-passes.c (inline_matmul_assign): Do not inline matmul
+	if the assignment to the resulting array if it is not of canonical
+	type (real/integer/complex/logical).
+
+2021-06-04  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_code_node): Handle
+	EXEC_OMP_(TARGET_)(,PARALLEL_,TEAMS_)LOOP.
+
+2021-06-04  Tobias Burnus  <tobias@codesourcery.com>
+
+	* scanner.c (skip_fixed_omp_sentinel): Set openacc_flag if
+	this is not an (OpenMP) continuation line.
+	(skip_fixed_oacc_sentinel): Likewise for openmp_flag and OpenACC.
+	(gfc_next_char_literal): gfc_error_now to force error for mixed OMP/ACC
+	continuation once per location and return '\n'.
+
+2021-06-04  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR middle-end/99928
+	* openmp.c (gfc_match_omp_clauses): Fix typo in error message.
+
+2021-06-04  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR middle-end/99928
+	* dump-parse-tree.c (show_omp_clauses): Handle bind clause.
+	(show_omp_node): Handle loop directive.
+	* frontend-passes.c (gfc_code_walker): Likewise.
+	* gfortran.h (enum gfc_statement): Add
+	ST_OMP_(END_)(TARGET_)(|PARALLEL_|TEAMS_)LOOP.
+	(enum gfc_omp_bind_type): New.
+	(gfc_omp_clauses): Use it.
+	(enum gfc_exec_op): Add EXEC_OMP_(TARGET_)(|PARALLEL_|TEAMS_)LOOP.
+	* match.h (gfc_match_omp_loop, gfc_match_omp_parallel_loop,
+	gfc_match_omp_target_parallel_loop, gfc_match_omp_target_teams_loop,
+	gfc_match_omp_teams_loop): New.
+	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_BIND.
+	(gfc_match_omp_clauses): Handle it.
+	(OMP_LOOP_CLAUSES, gfc_match_omp_loop, gfc_match_omp_teams_loop,
+	gfc_match_omp_target_teams_loop, gfc_match_omp_parallel_loop,
+	gfc_match_omp_target_parallel_loop): New.
+	(resolve_omp_clauses, resolve_omp_do, omp_code_to_statement,
+	gfc_resolve_omp_directive): Handle omp loop.
+	* parse.c (decode_omp_directive case_exec_markers, gfc_ascii_statement,
+	parse_omp_do, parse_executable): Likewise.
+	(parse_omp_structured_block): Remove ST_ which use parse_omp_do.
+	* resolve.c (gfc_resolve_blocks): Add omp loop.
+	* st.c (gfc_free_statement): Likewise.
+	* trans-openmp.c (gfc_trans_omp_clauses): Handle bind clause.
+	(gfc_trans_omp_do, gfc_trans_omp_parallel_do, gfc_trans_omp_distribute,
+	gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_directive):
+	Handle loop directive.
+	(gfc_split_omp_clauses): Likewise; fix firstprivate/lastprivate
+	and (in_)reduction for taskloop.
+	* trans.c (trans_code): Handle omp loop directive.
+
 2021-06-01  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR middle-end/99928
-- 
cgit v1.1


From d514626ee2566c68b8a79c7b99aaf791d69e1b2f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?=
 <jrfsousa@gmail.com>
Date: Sat, 5 Jun 2021 11:12:50 +0000
Subject: Fortran: Fix some issues with pointers to character.

gcc/fortran/ChangeLog:

	PR fortran/100120
	PR fortran/100816
	PR fortran/100818
	PR fortran/100819
	PR fortran/100821
	* trans-array.c (gfc_get_array_span): rework the way character
	array "span" was calculated.
	(gfc_conv_expr_descriptor): improve handling of character sections
	and unlimited polymorphic objects.
	* trans-expr.c (gfc_get_character_len): new function to calculate
	character string length.
	(gfc_get_character_len_in_bytes): new function to calculate
	character string length in bytes.
	(gfc_conv_scalar_to_descriptor): add call to set the "span".
	(gfc_trans_pointer_assignment): set "_len" and antecipate the
	initialization of the deferred character length hidden argument.
	* trans-intrinsic.c (gfc_conv_associated): set "force_no_tmp" to
	avoid the creation of a temporary.
	* trans-types.c (gfc_get_dtype_rank_type): rework type detection
	so that unlimited polymorphic objects get proper type infomation,
	also important for bind(c).
	(gfc_get_dtype): add argument to pass the rank if necessary.
	(gfc_get_array_type_bounds): cosmetic change to have character
	arrays called character instead of unknown.
	* trans-types.h (gfc_get_dtype): modify prototype.
	* trans.c (get_array_span): rework the way character array "span"
	was calculated.
	* trans.h (gfc_get_character_len): new prototype.
	(gfc_get_character_len_in_bytes): new prototype.
	Add "unlimited_polymorphic" flag to "gfc_se" type to signal when
	expression carries an unlimited polymorphic object.

libgfortran/ChangeLog:

	PR fortran/100120
	* intrinsics/associated.c (associated): have associated verify if
	the "span" matches insted of the "elem_len".
	* libgfortran.h (GFC_DESCRIPTOR_SPAN): add macro to retrive the
	descriptor "span".

gcc/testsuite/ChangeLog:

	PR fortran/100120
	* gfortran.dg/PR100120.f90: New test.
	PR fortran/100816
	PR fortran/100818
	PR fortran/100819
	PR fortran/100821
	* gfortran.dg/character_workout_1.f90: New test.
	* gfortran.dg/character_workout_4.f90: New test.
---
 gcc/fortran/trans-array.c     | 61 +++++++++++++++++++++++--------------
 gcc/fortran/trans-expr.c      | 70 ++++++++++++++++++++++++++++++++++---------
 gcc/fortran/trans-intrinsic.c |  1 +
 gcc/fortran/trans-types.c     | 68 ++++++++++++++++++++++++++++-------------
 gcc/fortran/trans-types.h     |  2 +-
 gcc/fortran/trans.c           | 26 ++++------------
 gcc/fortran/trans.h           |  5 ++++
 7 files changed, 154 insertions(+), 79 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 7eeef55..a6bcd2b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -860,16 +860,25 @@ gfc_get_array_span (tree desc, gfc_expr *expr)
 	 size of the array. Attempt to deal with unbounded character
 	 types if possible. Otherwise, return NULL_TREE.  */
       tmp = gfc_get_element_type (TREE_TYPE (desc));
-      if (tmp && TREE_CODE (tmp) == ARRAY_TYPE
-	  && (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp)) == NULL_TREE
-	      || integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (tmp)))))
-	{
-	  if (expr->expr_type == EXPR_VARIABLE
-	      && expr->ts.type == BT_CHARACTER)
-	    tmp = fold_convert (gfc_array_index_type,
-				gfc_get_expr_charlen (expr));
-	  else
-	    tmp = NULL_TREE;
+      if (tmp && TREE_CODE (tmp) == ARRAY_TYPE && TYPE_STRING_FLAG (tmp))
+	{
+	  gcc_assert (expr->ts.type == BT_CHARACTER);
+	  
+	  tmp = gfc_get_character_len_in_bytes (tmp);
+	  
+	  if (tmp == NULL_TREE || integer_zerop (tmp))
+	    {
+	      tree bs;
+
+	      tmp = gfc_get_expr_charlen (expr);
+	      tmp = fold_convert (gfc_array_index_type, tmp);
+	      bs = build_int_cst (gfc_array_index_type, expr->ts.kind);
+	      tmp = fold_build2_loc (input_location, MULT_EXPR,
+				     gfc_array_index_type, tmp, bs);
+	    }
+	  
+	  tmp = (tmp && !integer_zerop (tmp))
+	    ? (fold_convert (gfc_array_index_type, tmp)) : (NULL_TREE);
 	}
       else
 	tmp = fold_convert (gfc_array_index_type,
@@ -7328,6 +7337,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       expr = expr->value.function.actual->expr;
     }
 
+  if (!se->direct_byref)
+    se->unlimited_polymorphic = UNLIMITED_POLY (expr);
+  
   /* Special case things we know we can pass easily.  */
   switch (expr->expr_type)
     {
@@ -7351,9 +7363,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	  && TREE_CODE (desc) == COMPONENT_REF)
 	deferred_array_component = true;
 
-      subref_array_target = se->direct_byref && is_subref_array (expr);
-      need_tmp = gfc_ref_needs_temporary_p (expr->ref)
-			&& !subref_array_target;
+      subref_array_target = (is_subref_array (expr)
+			     && (se->direct_byref
+				 || expr->ts.type == BT_CHARACTER));
+      need_tmp = (gfc_ref_needs_temporary_p (expr->ref)
+		  && !subref_array_target);
 
       if (se->force_tmp)
 	need_tmp = 1;
@@ -7390,9 +7404,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 				      subref_array_target, expr);
 
 	      /* ....and set the span field.  */
-	      tmp = gfc_get_array_span (desc, expr);
-	      if (tmp != NULL_TREE && !integer_zerop (tmp))
-		gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
+	      tmp = gfc_conv_descriptor_span_get (desc);
+	      gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
 	    }
 	  else if (se->want_pointer)
 	    {
@@ -7607,6 +7620,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       int dim, ndim, codim;
       tree parm;
       tree parmtype;
+      tree dtype;
       tree stride;
       tree from;
       tree to;
@@ -7689,7 +7703,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
       else
 	{
 	  /* Otherwise make a new one.  */
-	  if (expr->ts.type == BT_CHARACTER && expr->ts.deferred)
+	  if (expr->ts.type == BT_CHARACTER)
 	    parmtype = gfc_typenode_for_spec (&expr->ts);
 	  else
 	    parmtype = gfc_get_element_type (TREE_TYPE (desc));
@@ -7723,11 +7737,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 	}
 
       /* Set the span field.  */
-      if (expr->ts.type == BT_CHARACTER && ss_info->string_length)
-	tmp = ss_info->string_length;
-      else
-	tmp = gfc_get_array_span (desc, expr);
-      if (tmp != NULL_TREE)
+      tmp = gfc_get_array_span (desc, expr);
+      if (tmp)
 	gfc_conv_descriptor_span_set (&loop.pre, parm, tmp);
 
       /* The following can be somewhat confusing.  We have two
@@ -7741,7 +7752,11 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
 
       /* Set the dtype.  */
       tmp = gfc_conv_descriptor_dtype (parm);
-      gfc_add_modify (&loop.pre, tmp, gfc_get_dtype (parmtype));
+      if (se->unlimited_polymorphic)
+	dtype = gfc_get_dtype (TREE_TYPE (desc), &loop.dimen);
+      else
+	dtype = gfc_get_dtype (parmtype);
+      gfc_add_modify (&loop.pre, tmp, dtype);
 
       /* The 1st element in the section.  */
       base = gfc_index_zero_node;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 00690fe..e3bc886 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -42,6 +42,45 @@ along with GCC; see the file COPYING3.  If not see
 #include "dependency.h"
 #include "gimplify.h"
 
+
+/* Calculate the number of characters in a string.  */
+
+tree
+gfc_get_character_len (tree type)
+{
+  tree len;
+  
+  gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE
+	      && TYPE_STRING_FLAG (type));
+  
+  len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+  len = (len) ? (len) : (integer_zero_node);
+  return fold_convert (gfc_charlen_type_node, len);
+}
+
+
+
+/* Calculate the number of bytes in a string.  */
+
+tree
+gfc_get_character_len_in_bytes (tree type)
+{
+  tree tmp, len;
+  
+  gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE
+	      && TYPE_STRING_FLAG (type));
+  
+  tmp = TYPE_SIZE_UNIT (TREE_TYPE (type));
+  tmp = (tmp && !integer_zerop (tmp))
+    ? (fold_convert (gfc_charlen_type_node, tmp)) : (NULL_TREE);
+  len = gfc_get_character_len (type);
+  if (tmp && len && !integer_zerop (len))
+    len = fold_build2_loc (input_location, MULT_EXPR,
+			   gfc_charlen_type_node, len, tmp);
+  return len;
+}
+
+
 /* Convert a scalar to an array descriptor. To be used for assumed-rank
    arrays.  */
 
@@ -87,6 +126,8 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
   gfc_add_modify (&se->pre, gfc_conv_descriptor_dtype (desc),
 		  gfc_get_dtype_rank_type (0, etype));
   gfc_conv_descriptor_data_set (&se->pre, desc, scalar);
+  gfc_conv_descriptor_span_set (&se->pre, desc,
+				gfc_conv_descriptor_elem_len (desc));
 
   /* Copy pointer address back - but only if it could have changed and
      if the actual argument is a pointer and not, e.g., NULL().  */
@@ -9630,11 +9671,12 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	  lse.direct_byref = 1;
 	  gfc_conv_expr_descriptor (&lse, expr2);
 	  strlen_rhs = lse.string_length;
+	  gfc_init_se (&rse, NULL);
 
 	  if (expr1->ts.type == BT_CLASS)
 	    {
 	      rse.expr = NULL_TREE;
-	      rse.string_length = NULL_TREE;
+	      rse.string_length = strlen_rhs;
 	      trans_class_vptr_len_assignment (&block, expr1, expr2, &rse,
 					       NULL, NULL);
 	    }
@@ -9694,6 +9736,19 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 	  gfc_add_modify (&lse.pre, desc, tmp);
 	}
 
+      if (expr1->ts.type == BT_CHARACTER
+	  && expr1->symtree->n.sym->ts.deferred
+	  && expr1->symtree->n.sym->ts.u.cl->backend_decl
+	  && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl))
+	{
+	  tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl;
+	  if (expr2->expr_type != EXPR_NULL)
+	    gfc_add_modify (&block, tmp,
+			    fold_convert (TREE_TYPE (tmp), strlen_rhs));
+	  else
+	    gfc_add_modify (&block, tmp, build_zero_cst (TREE_TYPE (tmp)));
+	}
+
       gfc_add_block_to_block (&block, &lse.pre);
       if (rank_remap)
 	gfc_add_block_to_block (&block, &rse.pre);
@@ -9856,19 +9911,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 				   msg, rsize, lsize);
 	}
 
-      if (expr1->ts.type == BT_CHARACTER
-	  && expr1->symtree->n.sym->ts.deferred
-	  && expr1->symtree->n.sym->ts.u.cl->backend_decl
-	  && VAR_P (expr1->symtree->n.sym->ts.u.cl->backend_decl))
-	{
-	  tmp = expr1->symtree->n.sym->ts.u.cl->backend_decl;
-	  if (expr2->expr_type != EXPR_NULL)
-	    gfc_add_modify (&block, tmp,
-			    fold_convert (TREE_TYPE (tmp), strlen_rhs));
-	  else
-	    gfc_add_modify (&block, tmp, build_zero_cst (TREE_TYPE (tmp)));
-	}
-
       /* Check string lengths if applicable.  The check is only really added
 	 to the output code if -fbounds-check is enabled.  */
       if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 98fa28d..73b0bcc 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -9080,6 +9080,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
 	  gfc_add_block_to_block (&se->post, &arg1se.post);
 
 	  arg2se.want_pointer = 1;
+	  arg2se.force_no_tmp = 1;
 	  gfc_conv_expr_descriptor (&arg2se, arg2->expr);
 	  gfc_add_block_to_block (&se->pre, &arg2se.pre);
 	  gfc_add_block_to_block (&se->post, &arg2se.post);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 9f21b3e..5582e40 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1482,6 +1482,7 @@ gfc_get_desc_dim_type (void)
 tree
 gfc_get_dtype_rank_type (int rank, tree etype)
 {
+  tree ptype;
   tree size;
   int n;
   tree tmp;
@@ -1489,12 +1490,24 @@ gfc_get_dtype_rank_type (int rank, tree etype)
   tree field;
   vec<constructor_elt, va_gc> *v = NULL;
 
-  size = TYPE_SIZE_UNIT (etype);
+  ptype = etype;
+  while (TREE_CODE (etype) == POINTER_TYPE
+	 || TREE_CODE (etype) == ARRAY_TYPE)
+    {
+      ptype = etype;
+      etype = TREE_TYPE (etype);
+    }
+
+  gcc_assert (etype);
 
   switch (TREE_CODE (etype))
     {
     case INTEGER_TYPE:
-      n = BT_INTEGER;
+      if (TREE_CODE (ptype) == ARRAY_TYPE
+	  && TYPE_STRING_FLAG (ptype))
+	n = BT_CHARACTER;
+      else
+	n = BT_INTEGER;
       break;
 
     case BOOLEAN_TYPE:
@@ -1516,27 +1529,36 @@ gfc_get_dtype_rank_type (int rank, tree etype)
 	n = BT_DERIVED;
       break;
 
-    /* We will never have arrays of arrays.  */
-    case ARRAY_TYPE:
-      n = BT_CHARACTER;
-      if (size == NULL_TREE)
-	size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
+    case FUNCTION_TYPE:
+    case VOID_TYPE:
+      n = BT_VOID;
       break;
 
-    case POINTER_TYPE:
-      n = BT_ASSUMED;
-      if (TREE_CODE (TREE_TYPE (etype)) != VOID_TYPE)
-	size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
-      else
-	size = build_int_cst (size_type_node, 0);
-    break;
-
     default:
       /* TODO: Don't do dtype for temporary descriptorless arrays.  */
       /* We can encounter strange array types for temporary arrays.  */
-      return gfc_index_zero_node;
+      gcc_unreachable ();
     }
 
+  switch (n)
+    {
+    case BT_CHARACTER:
+      gcc_assert (TREE_CODE (ptype) == ARRAY_TYPE);
+      size = gfc_get_character_len_in_bytes (ptype);
+      break;
+    case BT_VOID:
+      gcc_assert (TREE_CODE (ptype) == POINTER_TYPE);
+      size = size_in_bytes (ptype);
+      break;
+    default:
+      size = size_in_bytes (etype);
+      break;
+    }
+      
+  gcc_assert (size);
+
+  STRIP_NOPS (size);
+  size = fold_convert (size_type_node, size);
   tmp = get_dtype_type_node ();
   field = gfc_advance_chain (TYPE_FIELDS (tmp),
 			     GFC_DTYPE_ELEM_LEN);
@@ -1560,17 +1582,17 @@ gfc_get_dtype_rank_type (int rank, tree etype)
 
 
 tree
-gfc_get_dtype (tree type)
+gfc_get_dtype (tree type, int * rank)
 {
   tree dtype;
   tree etype;
-  int rank;
+  int irnk;
 
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
 
-  rank = GFC_TYPE_ARRAY_RANK (type);
+  irnk = (rank) ? (*rank) : (GFC_TYPE_ARRAY_RANK (type));
   etype = gfc_get_element_type (type);
-  dtype = gfc_get_dtype_rank_type (rank, etype);
+  dtype = gfc_get_dtype_rank_type (irnk, etype);
 
   GFC_TYPE_ARRAY_DTYPE (type) = dtype;
   return dtype;
@@ -1912,7 +1934,11 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
   TYPE_TYPELESS_STORAGE (fat_type) = 1;
   gcc_checking_assert (!get_alias_set (base_type) && !get_alias_set (fat_type));
 
-  tmp = TYPE_NAME (etype);
+  tmp = etype;
+  if (TREE_CODE (tmp) == ARRAY_TYPE
+      && TYPE_STRING_FLAG (tmp))
+    tmp = TREE_TYPE (etype);
+  tmp = TYPE_NAME (tmp);
   if (tmp && TREE_CODE (tmp) == TYPE_DECL)
     tmp = DECL_NAME (tmp);
   if (tmp)
diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h
index ff01226..3b45ce2 100644
--- a/gcc/fortran/trans-types.h
+++ b/gcc/fortran/trans-types.h
@@ -114,7 +114,7 @@ int gfc_is_nodesc_array (gfc_symbol *);
 
 /* Return the DTYPE for an array.  */
 tree gfc_get_dtype_rank_type (int, tree);
-tree gfc_get_dtype (tree);
+tree gfc_get_dtype (tree, int *rank = NULL);
 
 tree gfc_get_ppc_type (gfc_component *);
 tree gfc_get_caf_vector_type (int dim);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 3ffa394..f26e91b 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -371,30 +371,16 @@ get_array_span (tree type, tree decl)
     return gfc_conv_descriptor_span_get (decl);
 
   /* Return the span for deferred character length array references.  */
-  if (type && TREE_CODE (type) == ARRAY_TYPE
-      && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE
-      && (VAR_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))
-	  || TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF)
-      && (TREE_CODE (TYPE_MAX_VALUE (TYPE_DOMAIN (type))) == INDIRECT_REF
-	  || TREE_CODE (decl) == FUNCTION_DECL
-	  || DECL_CONTEXT (TYPE_MAX_VALUE (TYPE_DOMAIN (type)))
-					== DECL_CONTEXT (decl)))
-    {
-      span = fold_convert (gfc_array_index_type,
-			   TYPE_MAX_VALUE (TYPE_DOMAIN (type)));
-      span = fold_build2 (MULT_EXPR, gfc_array_index_type,
-			  fold_convert (gfc_array_index_type,
-					TYPE_SIZE_UNIT (TREE_TYPE (type))),
-			  span);
-    }
-  else if (type && TREE_CODE (type) == ARRAY_TYPE
-	   && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE
-	   && integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
+  if (type && TREE_CODE (type) == ARRAY_TYPE && TYPE_STRING_FLAG (type))
     {
+      if (TREE_CODE (decl) == PARM_DECL)
+	decl = build_fold_indirect_ref_loc (input_location, decl);
       if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
 	span = gfc_conv_descriptor_span_get (decl);
       else
-	span = NULL_TREE;
+	span = gfc_get_character_len_in_bytes (type);
+      span = (span && !integer_zerop (span))
+	? (fold_convert (gfc_array_index_type, span)) : (NULL_TREE);
     }
   /* Likewise for class array or pointer array references.  */
   else if (TREE_CODE (decl) == FIELD_DECL
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 69d3fdc..d1d4a1d 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -53,6 +53,9 @@ typedef struct gfc_se
      here.  */
   tree class_vptr;
 
+  /* Whether expr is a reference to an unlimited polymorphic object.  */
+  unsigned unlimited_polymorphic:1;
+  
   /* If set gfc_conv_variable will return an expression for the array
      descriptor. When set, want_pointer should also be set.
      If not set scalarizing variables will be substituted.  */
@@ -506,6 +509,8 @@ void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree);
 
 
 /* trans-expr.c */
+tree gfc_get_character_len (tree);
+tree gfc_get_character_len_in_bytes (tree);
 tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute);
 tree gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *, gfc_expr *);
 void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr);
-- 
cgit v1.1


From 28c62475050d2ac6c243580e1130a87308e1e907 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sun, 6 Jun 2021 00:16:22 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 33ab58a..12b932f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,37 @@
+2021-06-05  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
+
+	PR fortran/100120
+	PR fortran/100816
+	PR fortran/100818
+	PR fortran/100819
+	PR fortran/100821
+	* trans-array.c (gfc_get_array_span): rework the way character
+	array "span" was calculated.
+	(gfc_conv_expr_descriptor): improve handling of character sections
+	and unlimited polymorphic objects.
+	* trans-expr.c (gfc_get_character_len): new function to calculate
+	character string length.
+	(gfc_get_character_len_in_bytes): new function to calculate
+	character string length in bytes.
+	(gfc_conv_scalar_to_descriptor): add call to set the "span".
+	(gfc_trans_pointer_assignment): set "_len" and antecipate the
+	initialization of the deferred character length hidden argument.
+	* trans-intrinsic.c (gfc_conv_associated): set "force_no_tmp" to
+	avoid the creation of a temporary.
+	* trans-types.c (gfc_get_dtype_rank_type): rework type detection
+	so that unlimited polymorphic objects get proper type infomation,
+	also important for bind(c).
+	(gfc_get_dtype): add argument to pass the rank if necessary.
+	(gfc_get_array_type_bounds): cosmetic change to have character
+	arrays called character instead of unknown.
+	* trans-types.h (gfc_get_dtype): modify prototype.
+	* trans.c (get_array_span): rework the way character array "span"
+	was calculated.
+	* trans.h (gfc_get_character_len): new prototype.
+	(gfc_get_character_len_in_bytes): new prototype.
+	Add "unlimited_polymorphic" flag to "gfc_se" type to signal when
+	expression carries an unlimited polymorphic object.
+
 2021-06-04  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/99839
-- 
cgit v1.1


From 48aa5c60034736a439f2214dac34b165e74a7d20 Mon Sep 17 00:00:00 2001
From: Martin Liska <mliska@suse.cz>
Date: Tue, 8 Jun 2021 09:42:18 +0200
Subject: Fix "tailing" typo.

gcc/fortran/ChangeLog:

	* intrinsic.texi: Fix typo.
	* trans-expr.c (gfc_trans_pointer_assignment): Likewise.

gcc/ChangeLog:

	* genautomata.c (create_automata): Fix typo.

libgfortran/ChangeLog:

	* intrinsics/chmod.c (chmod_internal): Fix typo.
	* io/transfer.c (read_sf): Likewise.

libquadmath/ChangeLog:

	* libquadmath.texi: Fix typo.

gcc/testsuite/ChangeLog:

	* gcc.dg/format/strfmon-1.c: Fix typo.
	* gfortran.dg/char4-subscript.f90: Likewise.
---
 gcc/fortran/intrinsic.texi | 2 +-
 gcc/fortran/trans-expr.c   | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index c9049b53..260dbaa 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -502,7 +502,7 @@ Inquiry function
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{NAME} @tab Scalar @code{CHARACTER} of default kind with the
-file name. Tailing blank are ignored unless the character @code{achar(0)}
+file name. Trailing blank are ignored unless the character @code{achar(0)}
 is present, then all characters up to and excluding @code{achar(0)} are
 used as file name.
 @item @var{MODE} @tab Scalar @code{CHARACTER} of default kind with the
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index e3bc886..de406ad 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -9513,7 +9513,7 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
     {
       gfc_add_data_component (expr2);
       /* The following is required as gfc_add_data_component doesn't
-	 update ts.type if there is a tailing REF_ARRAY.  */
+	 update ts.type if there is a trailing REF_ARRAY.  */
       expr2->ts.type = BT_DERIVED;
     }
 
-- 
cgit v1.1


From 245517470d6948a40cead9f5c312b8d79ac5c491 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 8 Jun 2021 09:51:09 +0200
Subject: Fortran/OpenMP: Fix clause splitting for target/parallel/teams
 [PR99928]

	PR middle-end/99928

gcc/fortran/ChangeLog:

	* trans-openmp.c (gfc_add_clause_implicitly): New.
	(gfc_split_omp_clauses): Use it.
	(gfc_free_split_omp_clauses): New.
	(gfc_trans_omp_do_simd, gfc_trans_omp_parallel_do,
	gfc_trans_omp_parallel_do_simd, gfc_trans_omp_distribute,
	gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_taskloop,
	gfc_trans_omp_master_taskloop, gfc_trans_omp_parallel_master): Use it.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/openmp-simd-6.f90: Update scan-tree-dump.
	* gfortran.dg/gomp/scan-5.f90: Likewise.
	* gfortran.dg/gomp/loop-1.f90: Likewise; remove xfail.
	* gfortran.dg/gomp/pr99928-1.f90: Remove xfail.
	* gfortran.dg/gomp/pr99928-2.f90: Likewise.
	* gfortran.dg/gomp/pr99928-3.f90: Likewise.
	* gfortran.dg/gomp/pr99928-8.f90: Likewise.
---
 gcc/fortran/trans-openmp.c | 187 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 184 insertions(+), 3 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 1e22cdb..c8c61a5 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -5358,6 +5358,147 @@ enum
   GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP)
 };
 
+/* If a var is in lastprivate/firstprivate/reduction but not in a
+   data mapping/sharing clause, add it to 'map(tofrom:' if is_target
+   and to 'shared' otherwise.  */
+static void
+gfc_add_clause_implicitly (gfc_omp_clauses *clauses_out,
+			   gfc_omp_clauses *clauses_in,
+			   bool is_target, bool is_parallel_do)
+{
+  int clauselist_to_add = is_target ? OMP_LIST_MAP : OMP_LIST_SHARED;
+  gfc_omp_namelist *tail = NULL;
+  for (int i = 0; i < 5; ++i)
+    {
+      gfc_omp_namelist *n;
+      switch (i)
+	{
+	case 0: n = clauses_in->lists[OMP_LIST_FIRSTPRIVATE]; break;
+	case 1: n = clauses_in->lists[OMP_LIST_LASTPRIVATE]; break;
+	case 2: n = clauses_in->lists[OMP_LIST_REDUCTION]; break;
+	case 3: n = clauses_in->lists[OMP_LIST_REDUCTION_INSCAN]; break;
+	case 4: n = clauses_in->lists[OMP_LIST_REDUCTION_TASK]; break;
+	default: gcc_unreachable ();
+	}
+      for (; n != NULL; n = n->next)
+	{
+	  gfc_omp_namelist *n2, **n_firstp = NULL, **n_lastp = NULL;
+	  for (int j = 0; j < 6; ++j)
+	    {
+	      gfc_omp_namelist **n2ref = NULL, *prev2 = NULL;
+	      switch (j)
+		{
+		case 0:
+		  n2ref = &clauses_out->lists[clauselist_to_add];
+		  break;
+		case 1:
+		  n2ref = &clauses_out->lists[OMP_LIST_FIRSTPRIVATE];
+		  break;
+		case 2:
+		  if (is_target)
+		    n2ref = &clauses_in->lists[OMP_LIST_LASTPRIVATE];
+		  else
+		    n2ref = &clauses_out->lists[OMP_LIST_LASTPRIVATE];
+		  break;
+		case 3: n2ref = &clauses_out->lists[OMP_LIST_REDUCTION]; break;
+		case 4:
+		  n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_INSCAN];
+		  break;
+		case 5:
+		  n2ref = &clauses_out->lists[OMP_LIST_REDUCTION_TASK];
+		  break;
+		default: gcc_unreachable ();
+		}
+	      for (n2 = *n2ref; n2 != NULL; prev2 = n2, n2 = n2->next)
+		if (n2->sym == n->sym)
+		  break;
+	      if (n2)
+		{
+		  if (j == 0 /* clauselist_to_add */)
+		    break;  /* Already present.  */
+		  if (j == 1 /* OMP_LIST_FIRSTPRIVATE */)
+		    {
+		      n_firstp = prev2 ? &prev2->next : n2ref;
+		      continue;
+		    }
+		  if (j == 2 /* OMP_LIST_LASTPRIVATE */)
+		    {
+		      n_lastp = prev2 ? &prev2->next : n2ref;
+		      continue;
+		    }
+		  break;
+		}
+	    }
+	  if (n_firstp && n_lastp)
+	    {
+	      /* For parallel do, GCC puts firstprivatee/lastprivate
+		 on the parallel.  */
+	      if (is_parallel_do)
+		continue;
+	      *n_firstp = (*n_firstp)->next;
+	      if (!is_target)
+		*n_lastp = (*n_lastp)->next;
+	    }
+	  else if (is_target && n_lastp)
+	    ;
+	  else if (n2 || n_firstp || n_lastp)
+	    continue;
+	  if (clauses_out->lists[clauselist_to_add]
+	      && (clauses_out->lists[clauselist_to_add]
+		  == clauses_in->lists[clauselist_to_add]))
+	    {
+	      gfc_omp_namelist *p = NULL;
+	      for (n2 = clauses_in->lists[clauselist_to_add]; n2; n2 = n2->next)
+		{
+		  if (p)
+		    {
+		      p->next = gfc_get_omp_namelist ();
+		      p = p->next;
+		    }
+		  else
+		    {
+		      p = gfc_get_omp_namelist ();
+		      clauses_out->lists[clauselist_to_add] = p;
+		    }
+		  *p = *n2;
+		}
+	    }
+	  if (!tail)
+	    {
+	      tail = clauses_out->lists[clauselist_to_add];
+	      for (; tail && tail->next; tail = tail->next)
+		;
+	    }
+	  n2 = gfc_get_omp_namelist ();
+	  n2->where = n->where;
+	  n2->sym = n->sym;
+	  if (is_target)
+	    n2->u.map_op = OMP_MAP_TOFROM;
+	  if (tail)
+	    {
+	      tail->next = n2;
+	      tail = n2;
+	    }
+	  else
+	    clauses_out->lists[clauselist_to_add] = n2;
+	}
+    }
+}
+
+static void
+gfc_free_split_omp_clauses (gfc_code *code, gfc_omp_clauses *clausesa)
+{
+  for (int i = 0; i < GFC_OMP_SPLIT_NUM; ++i)
+    for (int j = 0; j < OMP_LIST_NUM; ++j)
+      if (clausesa[i].lists[j] && clausesa[i].lists[j] != code->ext.omp_clauses->lists[j])
+	for (gfc_omp_namelist *n = clausesa[i].lists[j]; n;)
+	  {
+	    gfc_omp_namelist *p = n;
+	    n = n->next;
+	    free (p);
+	  }
+}
+
 static void
 gfc_split_omp_clauses (gfc_code *code,
 		       gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM])
@@ -5689,7 +5830,8 @@ gfc_split_omp_clauses (gfc_code *code,
       if (mask & GFC_OMP_MASK_TASKLOOP)
 	clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_FIRSTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
-      if (mask & GFC_OMP_MASK_PARALLEL)
+      if ((mask & GFC_OMP_MASK_PARALLEL)
+	  && !(mask & GFC_OMP_MASK_TASKLOOP))
 	clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_FIRSTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_FIRSTPRIVATE];
       else if ((mask & GFC_OMP_MASK_DO) && !is_loop)
@@ -5704,7 +5846,8 @@ gfc_split_omp_clauses (gfc_code *code,
       if (mask & GFC_OMP_MASK_TASKLOOP)
 	clausesa[GFC_OMP_SPLIT_TASKLOOP].lists[OMP_LIST_LASTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
-      if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop)
+      if ((mask & GFC_OMP_MASK_PARALLEL) && !is_loop
+	  && !(mask & GFC_OMP_MASK_TASKLOOP))
 	clausesa[GFC_OMP_SPLIT_PARALLEL].lists[OMP_LIST_LASTPRIVATE]
 	  = code->ext.omp_clauses->lists[OMP_LIST_LASTPRIVATE];
       else if (mask & GFC_OMP_MASK_DO)
@@ -5731,6 +5874,7 @@ gfc_split_omp_clauses (gfc_code *code,
 	      = code->ext.omp_clauses->lists[i];
 	  if (mask & GFC_OMP_MASK_PARALLEL
 	      && i != OMP_LIST_REDUCTION_INSCAN
+	      && !(mask & GFC_OMP_MASK_TASKLOOP)
 	      && !is_loop)
 	    clausesa[GFC_OMP_SPLIT_PARALLEL].lists[i]
 	      = code->ext.omp_clauses->lists[i];
@@ -5752,6 +5896,18 @@ gfc_split_omp_clauses (gfc_code *code,
       clausesa[innermost].lists[OMP_LIST_LINEAR]
 	= code->ext.omp_clauses->lists[OMP_LIST_LINEAR];
     }
+   /* Propagate firstprivate/lastprivate/reduction vars to
+      shared (parallel, teams) and map-tofrom (target).  */
+   if (mask & GFC_OMP_MASK_TARGET)
+     gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TARGET],
+				code->ext.omp_clauses, true, false);
+   if ((mask & GFC_OMP_MASK_PARALLEL) && innermost != GFC_OMP_MASK_PARALLEL)
+     gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_PARALLEL],
+				code->ext.omp_clauses, false,
+				mask & GFC_OMP_MASK_DO);
+   if (mask & GFC_OMP_MASK_TEAMS && innermost != GFC_OMP_MASK_TEAMS)
+     gfc_add_clause_implicitly (&clausesa[GFC_OMP_SPLIT_TEAMS],
+				code->ext.omp_clauses, false, false);
    if (((mask & (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
 	== (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
        && !is_loop)
@@ -5765,6 +5921,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
   stmtblock_t block;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt, body, omp_do_clauses = NULL_TREE;
+  bool free_clausesa = false;
 
   if (pblock == NULL)
     gfc_start_block (&block);
@@ -5775,6 +5932,7 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   if (flag_openmp)
     omp_do_clauses
@@ -5800,6 +5958,8 @@ gfc_trans_omp_do_simd (gfc_code *code, stmtblock_t *pblock,
   else
     stmt = body;
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -5810,6 +5970,7 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
   stmtblock_t block, *new_pblock = pblock;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt, omp_clauses = NULL_TREE;
+  bool free_clausesa = false;
 
   if (pblock == NULL)
     gfc_start_block (&block);
@@ -5820,6 +5981,7 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   omp_clauses
     = gfc_trans_omp_clauses (&block, &clausesa[GFC_OMP_SPLIT_PARALLEL],
@@ -5848,6 +6010,8 @@ gfc_trans_omp_parallel_do (gfc_code *code, bool is_loop, stmtblock_t *pblock,
 		     void_type_node, stmt, omp_clauses);
   OMP_PARALLEL_COMBINED (stmt) = 1;
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -5858,6 +6022,7 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
   stmtblock_t block;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt, omp_clauses = NULL_TREE;
+  bool free_clausesa = false;
 
   if (pblock == NULL)
     gfc_start_block (&block);
@@ -5868,6 +6033,7 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   if (flag_openmp)
     omp_clauses
@@ -5892,6 +6058,8 @@ gfc_trans_omp_parallel_do_simd (gfc_code *code, stmtblock_t *pblock,
       OMP_PARALLEL_COMBINED (stmt) = 1;
     }
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6049,12 +6217,14 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
   stmtblock_t block;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt, omp_clauses = NULL_TREE;
+  bool free_clausesa = false;
 
   gfc_start_block (&block);
   if (clausesa == NULL)
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   if (flag_openmp)
     omp_clauses
@@ -6108,6 +6278,8 @@ gfc_trans_omp_distribute (gfc_code *code, gfc_omp_clauses *clausesa)
       stmt = distribute;
     }
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6118,13 +6290,14 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
   stmtblock_t block;
   gfc_omp_clauses clausesa_buf[GFC_OMP_SPLIT_NUM];
   tree stmt;
-  bool combined = true;
+  bool combined = true, free_clausesa = false;
 
   gfc_start_block (&block);
   if (clausesa == NULL)
     {
       clausesa = clausesa_buf;
       gfc_split_omp_clauses (code, clausesa);
+      free_clausesa = true;
     }
   if (flag_openmp)
     {
@@ -6167,6 +6340,8 @@ gfc_trans_omp_teams (gfc_code *code, gfc_omp_clauses *clausesa,
 	OMP_TEAMS_COMBINED (stmt) = 1;
     }
   gfc_add_expr_to_block (&block, stmt);
+  if (free_clausesa)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6276,6 +6451,7 @@ gfc_trans_omp_target (gfc_code *code)
       cfun->has_omp_target = true;
     }
   gfc_add_expr_to_block (&block, stmt);
+  gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6318,6 +6494,7 @@ gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op)
       stmt = taskloop;
     }
   gfc_add_expr_to_block (&block, stmt);
+  gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6341,6 +6518,8 @@ gfc_trans_omp_master_taskloop (gfc_code *code, gfc_exec_op op)
 			       op != code->op
 			       ? &clausesa[GFC_OMP_SPLIT_TASKLOOP]
 			       : code->ext.omp_clauses, NULL);
+      if (op != code->op)
+	gfc_free_split_omp_clauses (code, clausesa);
     }
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -6367,6 +6546,8 @@ gfc_trans_omp_parallel_master (gfc_code *code)
 				       ? code->ext.omp_clauses
 				       : &clausesa[GFC_OMP_SPLIT_PARALLEL],
 				       code->loc);
+  if (code->op != EXEC_OMP_PARALLEL_MASTER)
+    gfc_free_split_omp_clauses (code, clausesa);
   pushlevel ();
   if (code->op == EXEC_OMP_PARALLEL_MASTER)
     stmt = gfc_trans_omp_master (code);
-- 
cgit v1.1


From c60387214593445d1514bf7852f27f4523458cda Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 9 Jun 2021 00:16:30 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 12b932f..554afaa 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,19 @@
+2021-06-08  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR middle-end/99928
+	* trans-openmp.c (gfc_add_clause_implicitly): New.
+	(gfc_split_omp_clauses): Use it.
+	(gfc_free_split_omp_clauses): New.
+	(gfc_trans_omp_do_simd, gfc_trans_omp_parallel_do,
+	gfc_trans_omp_parallel_do_simd, gfc_trans_omp_distribute,
+	gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_taskloop,
+	gfc_trans_omp_master_taskloop, gfc_trans_omp_parallel_master): Use it.
+
+2021-06-08  Martin Liska  <mliska@suse.cz>
+
+	* intrinsic.texi: Fix typo.
+	* trans-expr.c (gfc_trans_pointer_assignment): Likewise.
+
 2021-06-05  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
 
 	PR fortran/100120
-- 
cgit v1.1


From d4d38135b3137f1d3148138340e67bdcd7ea8216 Mon Sep 17 00:00:00 2001
From: Jakub Jelinek <jakub@redhat.com>
Date: Wed, 9 Jun 2021 10:48:41 +0200
Subject: openmp: Gimplify OMP_CLAUSE_SIZE during gfc_omp_finish_clause
 [PR100965]

As the testcase shows, we need to gimplify OMP_CLAUSE_SIZE, so that we
don't end up with SAVE_EXPR or anything similar non-gimple in it.

2021-06-08  Jakub Jelinek  <jakub@redhat.com>

	PR fortran/100965
	* trans-openmp.c (gfc_omp_finish_clause): Gimplify OMP_CLAUSE_SIZE.

	* gfortran.dg/gomp/pr100965.f90: New test.
---
 gcc/fortran/trans-openmp.c | 3 +++
 1 file changed, 3 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index c8c61a5..f466ab6 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1639,6 +1639,9 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
     OMP_CLAUSE_SIZE (c)
       = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
 		      : TYPE_SIZE_UNIT (TREE_TYPE (decl));
+  if (gimplify_expr (&OMP_CLAUSE_SIZE (c), pre_p,
+		     NULL, is_gimple_val, fb_rvalue) == GS_ERROR)
+    OMP_CLAUSE_SIZE (c) = size_int (0);
   if (c2)
     {
       OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
-- 
cgit v1.1


From ec748dc7dd2d8ca39dc503b2a6dfbe172127cd13 Mon Sep 17 00:00:00 2001
From: Martin Liska <mliska@suse.cz>
Date: Wed, 9 Jun 2021 13:36:00 +0200
Subject: docs: add missing @headitem in Intrinsic Procedures

gcc/fortran/ChangeLog:

	* intrinsic.texi: Add missing @headitem to tables with a header.
---
 gcc/fortran/intrinsic.texi | 144 ++++++++++++++++++++++-----------------------
 1 file changed, 72 insertions(+), 72 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 260dbaa..8a92b86 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -462,7 +462,7 @@ end program test_abs
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{ABS(A)}   @tab @code{REAL(4) A}    @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{CABS(A)}  @tab @code{COMPLEX(4) A} @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{DABS(A)}  @tab @code{REAL(8) A}    @tab @code{REAL(8)}    @tab Fortran 77 and later
@@ -627,7 +627,7 @@ end program test_acos
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument         @tab Return type     @tab Standard
+@headitem Name            @tab Argument         @tab Return type     @tab Standard
 @item @code{ACOS(X)}  @tab @code{REAL(4) X} @tab @code{REAL(4)}  @tab Fortran 77 and later
 @item @code{DACOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}  @tab Fortran 77 and later
 @end multitable
@@ -686,7 +686,7 @@ end program test_acosd
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument         @tab Return type     @tab Standard
+@headitem Name            @tab Argument         @tab Return type     @tab Standard
 @item @code{ACOSD(X)}  @tab @code{REAL(4) X} @tab @code{REAL(4)}  @tab GNU extension
 @item @code{DACOSD(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}  @tab GNU extension
 @end multitable
@@ -742,7 +742,7 @@ END PROGRAM
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument          @tab Return type       @tab Standard
+@headitem Name             @tab Argument          @tab Return type       @tab Standard
 @item @code{DACOSH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
 
@@ -891,7 +891,7 @@ end program test_aimag
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name               @tab Argument            @tab Return type     @tab Standard
+@headitem Name               @tab Argument            @tab Return type     @tab Standard
 @item @code{AIMAG(Z)}    @tab @code{COMPLEX Z}    @tab @code{REAL}     @tab Fortran 77 and later
 @item @code{DIMAG(Z)}    @tab @code{COMPLEX(8) Z} @tab @code{REAL(8)}  @tab GNU extension
 @item @code{IMAG(Z)}     @tab @code{COMPLEX Z}    @tab @code{REAL}     @tab GNU extension
@@ -951,7 +951,7 @@ end program test_aint
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name           @tab Argument         @tab Return type      @tab Standard
+@headitem Name           @tab Argument         @tab Return type      @tab Standard
 @item @code{AINT(A)} @tab @code{REAL(4) A} @tab @code{REAL(4)}   @tab Fortran 77 and later
 @item @code{DINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)}   @tab Fortran 77 and later
 @end multitable
@@ -1231,7 +1231,7 @@ end program test_anint
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument         @tab Return type      @tab Standard
+@headitem Name            @tab Argument         @tab Return type      @tab Standard
 @item @code{ANINT(A)}  @tab @code{REAL(4) A} @tab @code{REAL(4)}   @tab Fortran 77 and later
 @item @code{DNINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)}   @tab Fortran 77 and later
 @end multitable
@@ -1347,7 +1347,7 @@ end program test_asin
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{ASIN(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{DASIN(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 and later
 @end multitable
@@ -1406,7 +1406,7 @@ end program test_asind
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{ASIND(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab GNU extension
 @item @code{DASIND(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
@@ -1462,7 +1462,7 @@ END PROGRAM
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument          @tab Return type       @tab Standard
+@headitem Name             @tab Argument          @tab Return type       @tab Standard
 @item @code{DASINH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension.
 @end multitable
 
@@ -1598,7 +1598,7 @@ end program test_atan
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{ATAN(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{DATAN(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 and later
 @end multitable
@@ -1663,7 +1663,7 @@ end program test_atand
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{ATAND(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab GNU extension
 @item @code{DATAND(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
@@ -1728,7 +1728,7 @@ end program test_atan2
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name                @tab Argument            @tab Return type    @tab Standard
+@headitem Name                @tab Argument            @tab Return type    @tab Standard
 @item @code{ATAN2(X, Y)}  @tab @code{REAL(4) X, Y} @tab @code{REAL(4)} @tab Fortran 77 and later
 @item @code{DATAN2(X, Y)} @tab @code{REAL(8) X, Y} @tab @code{REAL(8)} @tab Fortran 77 and later
 @end multitable
@@ -1796,7 +1796,7 @@ end program test_atan2d
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name                @tab Argument            @tab Return type    @tab Standard
+@headitem Name                @tab Argument            @tab Return type    @tab Standard
 @item @code{ATAN2D(X, Y)}  @tab @code{REAL(4) X, Y} @tab @code{REAL(4)} @tab GNU extension
 @item @code{DATAN2D(X, Y)} @tab @code{REAL(8) X, Y} @tab @code{REAL(8)} @tab GNU extension
 @end multitable
@@ -1852,7 +1852,7 @@ END PROGRAM
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument          @tab Return type       @tab Standard
+@headitem Name             @tab Argument          @tab Return type       @tab Standard
 @item @code{DATANH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
 
@@ -2541,7 +2541,7 @@ end program test_besj0
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{DBESJ0(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}   @tab GNU extension
 @end multitable
 @end table
@@ -2590,7 +2590,7 @@ end program test_besj1
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument          @tab Return type       @tab Standard
+@headitem Name             @tab Argument          @tab Return type       @tab Standard
 @item @code{DBESJ1(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
 @end table
@@ -2655,7 +2655,7 @@ end program test_besjn
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name                @tab Argument            @tab Return type       @tab Standard
+@headitem Name                @tab Argument            @tab Return type       @tab Standard
 @item @code{DBESJN(N, X)} @tab @code{INTEGER N}    @tab @code{REAL(8)}    @tab GNU extension
 @item                     @tab @code{REAL(8) X}    @tab                   @tab
 @end multitable
@@ -2703,7 +2703,7 @@ end program test_besy0
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{DBESY0(X)}@tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
 @end table
@@ -2750,7 +2750,7 @@ end program test_besy1
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{DBESY1(X)}@tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
 @end table
@@ -2815,7 +2815,7 @@ end program test_besyn
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name               @tab Argument            @tab Return type     @tab Standard
+@headitem Name               @tab Argument            @tab Return type     @tab Standard
 @item @code{DBESYN(N,X)} @tab @code{INTEGER N} @tab @code{REAL(8)}  @tab GNU extension
 @item                    @tab @code{REAL(8) X} @tab                 @tab 
 @end multitable
@@ -3058,7 +3058,7 @@ end program test_btest
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name           @tab Argument         @tab Return type             @tab Standard
+@headitem Name           @tab Argument         @tab Return type             @tab Standard
 @item @code{BTEST(I,POS)} @tab @code{INTEGER I,POS} @tab @code{LOGICAL} @tab Fortran 95 and later
 @item @code{BBTEST(I,POS)} @tab @code{INTEGER(1) I,POS} @tab @code{LOGICAL(1)} @tab GNU extension
 @item @code{BITEST(I,POS)} @tab @code{INTEGER(2) I,POS} @tab @code{LOGICAL(2)} @tab GNU extension
@@ -3475,7 +3475,7 @@ end program test_char
 
 @item @emph{Specific names}:
 @multitable @columnfractions .18 .18 .24 .25
-@item Name           @tab Argument         @tab Return type             @tab Standard
+@headitem Name           @tab Argument         @tab Return type             @tab Standard
 @item @code{CHAR(I)} @tab @code{INTEGER I} @tab @code{CHARACTER(LEN=1)} @tab Fortran 77 and later
 @end multitable
 
@@ -4204,7 +4204,7 @@ end program test_conjg
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument             @tab Return type       @tab Standard
+@headitem Name             @tab Argument             @tab Return type       @tab Standard
 @item @code{DCONJG(Z)} @tab @code{COMPLEX(8) Z}  @tab @code{COMPLEX(8)} @tab GNU extension
 @end multitable
 @end table
@@ -4255,7 +4255,7 @@ end program test_cos
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{COS(X)}   @tab @code{REAL(4) X}    @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{DCOS(X)}  @tab @code{REAL(8) X}    @tab @code{REAL(8)}    @tab Fortran 77 and later
 @item @code{CCOS(X)}  @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab Fortran 77 and later
@@ -4319,7 +4319,7 @@ end program test_cosd
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{COSD(X)}   @tab @code{REAL(4) X}    @tab @code{REAL(4)}    @tab GNU extension
 @item @code{DCOSD(X)}  @tab @code{REAL(8) X}    @tab @code{REAL(8)}    @tab GNU extension
 @item @code{CCOSD(X)}  @tab @code{COMPLEX(4) X} @tab @code{COMPLEX(4)} @tab GNU extension
@@ -4378,7 +4378,7 @@ end program test_cosh
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{COSH(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{DCOSH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 and later
 @end multitable
@@ -4432,7 +4432,7 @@ end program test_cotan
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type     @tab Standard
+@headitem Name            @tab Argument          @tab Return type     @tab Standard
 @item @code{COTAN(X)}   @tab @code{REAL(4) X}  @tab @code{REAL(4)}  @tab GNU extension
 @item @code{DCOTAN(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}  @tab GNU extension
 @end multitable
@@ -4488,7 +4488,7 @@ end program test_cotand
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type     @tab Standard
+@headitem Name            @tab Argument          @tab Return type     @tab Standard
 @item @code{COTAND(X)}   @tab @code{REAL(4) X}  @tab @code{REAL(4)}  @tab GNU extension
 @item @code{DCOTAND(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}  @tab GNU extension
 @end multitable
@@ -5003,7 +5003,7 @@ end program test_dim
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument               @tab Return type       @tab Standard
+@headitem Name             @tab Argument               @tab Return type       @tab Standard
 @item @code{DIM(X,Y)}  @tab @code{REAL(4) X, Y}    @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{IDIM(X,Y)} @tab @code{INTEGER(4) X, Y} @tab @code{INTEGER(4)} @tab Fortran 77 and later
 @item @code{DDIM(X,Y)} @tab @code{REAL(8) X, Y}    @tab @code{REAL(8)}    @tab Fortran 77 and later
@@ -5106,7 +5106,7 @@ end program test_dprod
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name              @tab Argument               @tab Return type       @tab Standard
+@headitem Name              @tab Argument               @tab Return type       @tab Standard
 @item @code{DPROD(X,Y)} @tab @code{REAL(4) X, Y}    @tab @code{REAL(8)}    @tab Fortran 77 and later
 @end multitable
 
@@ -5475,7 +5475,7 @@ end program test_erf
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{DERF(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
 @end table
@@ -5519,7 +5519,7 @@ end program test_erfc
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{DERFC(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
 @end table
@@ -5863,7 +5863,7 @@ end program test_exp
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument             @tab Return type         @tab Standard
+@headitem Name            @tab Argument             @tab Return type         @tab Standard
 @item @code{EXP(X)}   @tab @code{REAL(4) X}     @tab @code{REAL(4)}      @tab Fortran 77 and later
 @item @code{DEXP(X)}  @tab @code{REAL(8) X}     @tab @code{REAL(8)}      @tab Fortran 77 and later
 @item @code{CEXP(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)}   @tab Fortran 77 and later
@@ -6803,7 +6803,7 @@ end program test_gamma
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument         @tab Return type       @tab Standard
+@headitem Name             @tab Argument         @tab Return type       @tab Standard
 @item @code{DGAMMA(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}    @tab GNU extension
 @end multitable
 
@@ -7692,7 +7692,7 @@ END PROGRAM
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{IAND(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BIAND(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IIAND(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -7855,7 +7855,7 @@ The return value is of type @code{INTEGER} and of the same kind as
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{IBCLR(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BBCLR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IIBCLR(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -7914,7 +7914,7 @@ The return value is of type @code{INTEGER} and of the same kind as
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{IBITS(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BBITS(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IIBITS(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -7968,7 +7968,7 @@ The return value is of type @code{INTEGER} and of the same kind as
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{IBSET(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BBSET(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IIBSET(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -8029,7 +8029,7 @@ end program test_ichar
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument             @tab Return type       @tab Standard
+@headitem Name             @tab Argument             @tab Return type       @tab Standard
 @item @code{ICHAR(C)}  @tab @code{CHARACTER C}   @tab @code{INTEGER(4)}    @tab Fortran 77 and later
 @end multitable
 
@@ -8156,7 +8156,7 @@ type parameter of the other argument as-if a call to @ref{INT} occurred.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{IEOR(A)}  @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BIEOR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IIEOR(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -8293,7 +8293,7 @@ The return value is of type @code{INTEGER} and of kind @var{KIND}. If
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name                            @tab Argument           @tab Return type       @tab Standard
+@headitem Name                            @tab Argument           @tab Return type       @tab Standard
 @item @code{INDEX(STRING, SUBSTRING)} @tab @code{CHARACTER}   @tab @code{INTEGER(4)} @tab Fortran 77 and later
 @end multitable
 
@@ -8360,7 +8360,7 @@ end program
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{INT(A)}   @tab @code{REAL(4) A}  @tab @code{INTEGER}    @tab Fortran 77 and later
 @item @code{IFIX(A)}  @tab @code{REAL(4) A}  @tab @code{INTEGER}    @tab Fortran 77 and later
 @item @code{IDINT(A)} @tab @code{REAL(8) A}  @tab @code{INTEGER}    @tab Fortran 77 and later
@@ -8486,7 +8486,7 @@ type parameter of the other argument as-if a call to @ref{INT} occurred.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{IOR(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BIOR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IIOR(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -8840,7 +8840,7 @@ The return value is of type @code{INTEGER} and of the same kind as
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{ISHFT(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BSHFT(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IISHFT(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -8898,7 +8898,7 @@ The return value is of type @code{INTEGER} and of the same kind as
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{ISHFTC(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BSHFTC(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IISHFTC(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -9259,7 +9259,7 @@ The return value is of type @code{INTEGER} and of kind @var{KIND}. If
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name               @tab Argument          @tab Return type       @tab Standard
+@headitem Name               @tab Argument          @tab Return type       @tab Standard
 @item @code{LEN(STRING)} @tab @code{CHARACTER}  @tab @code{INTEGER}    @tab Fortran 77 and later
 @end multitable
 
@@ -9352,7 +9352,7 @@ otherwise, based on the ASCII ordering.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name                           @tab Argument          @tab Return type       @tab Standard
+@headitem Name                           @tab Argument          @tab Return type       @tab Standard
 @item @code{LGE(STRING_A, STRING_B)} @tab @code{CHARACTER}  @tab @code{LOGICAL}    @tab Fortran 77 and later
 @end multitable
 
@@ -9406,7 +9406,7 @@ otherwise, based on the ASCII ordering.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name                           @tab Argument          @tab Return type       @tab Standard
+@headitem Name                           @tab Argument          @tab Return type       @tab Standard
 @item @code{LGT(STRING_A, STRING_B)} @tab @code{CHARACTER}  @tab @code{LOGICAL}    @tab Fortran 77 and later
 @end multitable
 
@@ -9504,7 +9504,7 @@ otherwise, based on the ASCII ordering.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name                           @tab Argument          @tab Return type       @tab Standard
+@headitem Name                           @tab Argument          @tab Return type       @tab Standard
 @item @code{LLE(STRING_A, STRING_B)} @tab @code{CHARACTER}  @tab @code{LOGICAL}    @tab Fortran 77 and later
 @end multitable
 
@@ -9558,7 +9558,7 @@ otherwise, based on the ASCII ordering.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name                           @tab Argument          @tab Return type       @tab Standard
+@headitem Name                           @tab Argument          @tab Return type       @tab Standard
 @item @code{LLT(STRING_A, STRING_B)} @tab @code{CHARACTER}  @tab @code{LOGICAL}    @tab Fortran 77 and later
 @end multitable
 
@@ -9697,7 +9697,7 @@ end program test_log
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{ALOG(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 or later
 @item @code{DLOG(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 or later
 @item @code{CLOG(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)}    @tab Fortran 77 or later
@@ -9749,7 +9749,7 @@ end program test_log10
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{ALOG10(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{DLOG10(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 and later
 @end multitable
@@ -9798,7 +9798,7 @@ end program test_log_gamma
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument         @tab Return type       @tab Standard
+@headitem Name             @tab Argument         @tab Return type       @tab Standard
 @item @code{LGAMMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)}    @tab GNU extension
 @item @code{ALGAMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)}    @tab GNU extension
 @item @code{DLGAMA(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)}    @tab GNU extension
@@ -10257,7 +10257,7 @@ and has the same type and kind as the first argument.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument             @tab Return type         @tab Standard
+@headitem Name             @tab Argument             @tab Return type         @tab Standard
 @item @code{MAX0(A1)}  @tab @code{INTEGER(4) A1} @tab @code{INTEGER(4)}   @tab Fortran 77 and later
 @item @code{AMAX0(A1)} @tab @code{INTEGER(4) A1} @tab @code{REAL(MAX(X))} @tab Fortran 77 and later
 @item @code{MAX1(A1)}  @tab @code{REAL A1}       @tab @code{INT(MAX(X))}  @tab Fortran 77 and later
@@ -10632,7 +10632,7 @@ and has the same type and kind as the first argument.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name              @tab Argument             @tab Return type        @tab Standard
+@headitem Name              @tab Argument             @tab Return type        @tab Standard
 @item @code{MIN0(A1)}   @tab @code{INTEGER(4) A1} @tab @code{INTEGER(4)}  @tab Fortran 77 and later
 @item @code{AMIN0(A1)}  @tab @code{INTEGER(4) A1} @tab @code{REAL(4)}     @tab Fortran 77 and later
 @item @code{MIN1(A1)}   @tab @code{REAL A1}       @tab @code{INTEGER(4)}  @tab Fortran 77 and later
@@ -10865,7 +10865,7 @@ end program test_mod
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Arguments          @tab Return type    @tab Standard
+@headitem Name             @tab Arguments          @tab Return type    @tab Standard
 @item @code{MOD(A,P)}  @tab @code{INTEGER A,P} @tab @code{INTEGER} @tab Fortran 77 and later
 @item @code{AMOD(A,P)} @tab @code{REAL(4) A,P} @tab @code{REAL(4)} @tab Fortran 77 and later
 @item @code{DMOD(A,P)} @tab @code{REAL(8) A,P} @tab @code{REAL(8)} @tab Fortran 77 and later
@@ -11030,7 +11030,7 @@ same kind as @var{FROM}.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{MVBITS(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 90 and later
 @item @code{BMVBITS(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{IMVBITS(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -11180,7 +11180,7 @@ end program test_nint
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument           @tab Return Type     @tab Standard
+@headitem Name             @tab Argument           @tab Return Type     @tab Standard
 @item @code{NINT(A)}   @tab @code{REAL(4) A}   @tab  @code{INTEGER} @tab Fortran 77 and later
 @item @code{IDNINT(A)} @tab @code{REAL(8) A}   @tab  @code{INTEGER} @tab Fortran 77 and later
 @end multitable
@@ -11278,7 +11278,7 @@ argument.
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument            @tab Return type       @tab Standard
+@headitem Name            @tab Argument            @tab Return type       @tab Standard
 @item @code{NOT(A)}   @tab @code{INTEGER A}    @tab @code{INTEGER}    @tab Fortran 95 and later
 @item @code{BNOT(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension
 @item @code{INOT(A)} @tab @code{INTEGER(2) A} @tab @code{INTEGER(2)} @tab GNU extension
@@ -12294,7 +12294,7 @@ end program test_real
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument           @tab Return type     @tab Standard
+@headitem Name             @tab Argument           @tab Return type     @tab Standard
 @item @code{FLOAT(A)}  @tab @code{INTEGER(4)}  @tab @code{REAL(4)}  @tab GNU extension
 @item @code{DFLOAT(A)} @tab @code{INTEGER(4)}  @tab @code{REAL(8)}  @tab GNU extension
 @item @code{FLOATI(A)} @tab @code{INTEGER(2)}  @tab @code{REAL(4)}  @tab GNU extension
@@ -13198,7 +13198,7 @@ end program test_sign
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name              @tab Arguments              @tab Return type       @tab Standard
+@headitem Name              @tab Arguments              @tab Return type       @tab Standard
 @item @code{SIGN(A,B)}  @tab @code{REAL(4) A, B}    @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{ISIGN(A,B)} @tab @code{INTEGER(4) A, B} @tab @code{INTEGER(4)} @tab Fortran 77 and later
 @item @code{DSIGN(A,B)} @tab @code{REAL(8) A, B}    @tab @code{REAL(8)}    @tab Fortran 77 and later
@@ -13307,7 +13307,7 @@ end program test_sin
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument             @tab Return type       @tab Standard
+@headitem Name            @tab Argument             @tab Return type       @tab Standard
 @item @code{SIN(X)}   @tab @code{REAL(4) X}     @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{DSIN(X)}  @tab @code{REAL(8) X}     @tab @code{REAL(8)}    @tab Fortran 77 and later
 @item @code{CSIN(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)} @tab Fortran 77 and later
@@ -13369,7 +13369,7 @@ end program test_sind
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument             @tab Return type       @tab Standard
+@headitem Name            @tab Argument             @tab Return type       @tab Standard
 @item @code{SIND(X)}   @tab @code{REAL(4) X}     @tab @code{REAL(4)}    @tab GNU extension
 @item @code{DSIND(X)}  @tab @code{REAL(8) X}     @tab @code{REAL(8)}    @tab GNU extension
 @item @code{CSIND(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)} @tab GNU extension
@@ -13426,7 +13426,7 @@ end program test_sinh
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{DSINH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 90 and later
 @end multitable
 
@@ -13711,7 +13711,7 @@ end program test_sqrt
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name             @tab Argument             @tab Return type          @tab Standard
+@headitem Name             @tab Argument             @tab Return type          @tab Standard
 @item @code{SQRT(X)}   @tab @code{REAL(4) X}     @tab @code{REAL(4)}       @tab Fortran 77 and later
 @item @code{DSQRT(X)}  @tab @code{REAL(8) X}     @tab @code{REAL(8)}       @tab Fortran 77 and later
 @item @code{CSQRT(X)}  @tab @code{COMPLEX(4) X}  @tab @code{COMPLEX(4)}    @tab Fortran 77 and later
@@ -14162,7 +14162,7 @@ end program test_tan
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type     @tab Standard
+@headitem Name            @tab Argument          @tab Return type     @tab Standard
 @item @code{TAN(X)}   @tab @code{REAL(4) X}  @tab @code{REAL(4)}  @tab Fortran 77 and later
 @item @code{DTAN(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}  @tab Fortran 77 and later
 @end multitable
@@ -14217,7 +14217,7 @@ end program test_tand
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type     @tab Standard
+@headitem Name            @tab Argument          @tab Return type     @tab Standard
 @item @code{TAND(X)}   @tab @code{REAL(4) X}  @tab @code{REAL(4)}  @tab GNU extension
 @item @code{DTAND(X)}  @tab @code{REAL(8) X}  @tab @code{REAL(8)}  @tab GNU extension
 @end multitable
@@ -14273,7 +14273,7 @@ end program test_tanh
 
 @item @emph{Specific names}:
 @multitable @columnfractions .20 .20 .20 .25
-@item Name            @tab Argument          @tab Return type       @tab Standard
+@headitem Name            @tab Argument          @tab Return type       @tab Standard
 @item @code{TANH(X)}  @tab @code{REAL(4) X}  @tab @code{REAL(4)}    @tab Fortran 77 and later
 @item @code{DTANH(X)} @tab @code{REAL(8) X}  @tab @code{REAL(8)}    @tab Fortran 77 and later
 @end multitable
@@ -15197,7 +15197,7 @@ Furthermore, if @code{__float128} is supported in C, the named constants
 @code{C_FLOAT128, C_FLOAT128_COMPLEX} are defined.
 
 @multitable @columnfractions .15 .35 .35 .35
-@item Fortran Type  @tab Named constant         @tab C type                                @tab Extension
+@headitem Fortran Type  @tab Named constant         @tab C type                                @tab Extension
 @item @code{INTEGER}@tab @code{C_INT}           @tab @code{int}
 @item @code{INTEGER}@tab @code{C_SHORT}         @tab @code{short int}
 @item @code{INTEGER}@tab @code{C_LONG}          @tab @code{long int}
@@ -15238,7 +15238,7 @@ Additionally, the following parameters of type @code{CHARACTER(KIND=C_CHAR)}
 are defined.
 
 @multitable @columnfractions .20 .45 .15
-@item Name                     @tab C definition    @tab Value
+@headitem Name                     @tab C definition    @tab Value
 @item @code{C_NULL_CHAR}       @tab null character  @tab @code{'\0'}
 @item @code{C_ALERT}           @tab alert           @tab @code{'\a'}
 @item @code{C_BACKSPACE}       @tab backspace       @tab @code{'\b'}
@@ -15252,7 +15252,7 @@ are defined.
 Moreover, the following two named constants are defined:
 
 @multitable @columnfractions .20 .80
-@item Name                 @tab Type
+@headitem Name                 @tab Type
 @item @code{C_NULL_PTR}    @tab @code{C_PTR}
 @item @code{C_NULL_FUNPTR} @tab @code{C_FUNPTR}
 @end multitable
-- 
cgit v1.1


From 4f625f47b4456e5c05a025fca4d072831e59126c Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 10 Jun 2021 00:16:30 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 9 +++++++++
 1 file changed, 9 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 554afaa..242c680 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2021-06-09  Martin Liska  <mliska@suse.cz>
+
+	* intrinsic.texi: Add missing @headitem to tables with a header.
+
+2021-06-09  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/100965
+	* trans-openmp.c (gfc_omp_finish_clause): Gimplify OMP_CLAUSE_SIZE.
+
 2021-06-08  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR middle-end/99928
-- 
cgit v1.1


From a893b26f7311fe65b604f12a8fa5d5d64f5454e2 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 14 Jun 2021 14:36:20 +0200
Subject: Fortran: resolve.c - remove '*XCNEW' based nullifying

gcc/fortran/ChangeLog:

	* resolve.c (resolve_variable): Remove *XCNEW used to
	nullify nullified memory.
---
 gcc/fortran/resolve.c | 1 -
 1 file changed, 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a37ad66..45c3ad3 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5709,7 +5709,6 @@ resolve_variable (gfc_expr *e)
 	     part_ref.  */
 	  gfc_ref *ref = gfc_get_ref ();
 	  ref->type = REF_ARRAY;
-	  ref->u.ar = *gfc_get_array_ref();
 	  ref->u.ar.type = AR_FULL;
 	  if (sym->as)
 	    {
-- 
cgit v1.1


From 8dc48181affa1d03ec8d47e513d1c62bd16da6f3 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 15 Jun 2021 00:16:37 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 242c680..a0ee6eb 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2021-06-14  Tobias Burnus  <tobias@codesourcery.com>
+
+	* resolve.c (resolve_variable): Remove *XCNEW used to
+	nullify nullified memory.
+
 2021-06-09  Martin Liska  <mliska@suse.cz>
 
 	* intrinsic.texi: Add missing @headitem to tables with a header.
-- 
cgit v1.1


From 1de31913d20a467b78904c0e96efd5fbd6facd2c Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 15 Jun 2021 16:06:38 +0200
Subject: Fortran/OpenMP: Extend defaultmap clause for OpenMP 5 [PR92568]

	PR fortran/92568

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Update for defaultmap.
	* f95-lang.c (LANG_HOOKS_OMP_ALLOCATABLE_P,
	LANG_HOOKS_OMP_SCALAR_TARGET_P): New.
	* gfortran.h (enum gfc_omp_defaultmap,
	enum gfc_omp_defaultmap_category): New.
	* openmp.c (gfc_match_omp_clauses): Update defaultmap matching.
	* trans-decl.c (gfc_finish_decl_attrs): Set GFC_DECL_SCALAR_TARGET.
	* trans-openmp.c (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New.
	(gfc_omp_scalar_p): Take 'ptr_alloc_ok' argument.
	(gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for
	defaultmap changes.
	* trans.h (gfc_omp_scalar_p): Update prototype.
	(gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New.
	(struct lang_decl): Add scalar_target.
	(GFC_DECL_SCALAR_TARGET, GFC_DECL_GET_SCALAR_TARGET): New.

gcc/ChangeLog:

	* gimplify.c (enum gimplify_defaultmap_kind): Add GDMK_SCALAR_TARGET.
	(struct gimplify_omp_ctx): Extend defaultmap array by one.
	(new_omp_context): Init defaultmap[GDMK_SCALAR_TARGET].
	(omp_notice_variable): Update type classification for Fortran.
	(gimplify_scan_omp_clauses): Update calls for new argument; handle
	GDMK_SCALAR_TARGET; for Fortran, GDMK_POINTER avoid GOVD_MAP_0LEN_ARRAY.
	* langhooks-def.h (lhd_omp_scalar_p): Add 'ptr_ok' argument.
	* langhooks.c (lhd_omp_scalar_p): Likewise.
	(LANG_HOOKS_OMP_ALLOCATABLE_P, LANG_HOOKS_OMP_SCALAR_TARGET_P): New.
	(LANG_HOOKS_DECLS): Add them.
	* langhooks.h (struct lang_hooks_for_decls): Add new hooks, update
	omp_scalar_p pointer type to include the new bool argument.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/defaultmap-8.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/pr99928-1.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-2.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-3.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-4.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-5.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-6.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/pr99928-8.f90: Uncomment 'defaultmap(none)'.
	* gfortran.dg/gomp/defaultmap-1.f90: New test.
	* gfortran.dg/gomp/defaultmap-2.f90: New test.
	* gfortran.dg/gomp/defaultmap-3.f90: New test.
	* gfortran.dg/gomp/defaultmap-4.f90: New test.
	* gfortran.dg/gomp/defaultmap-5.f90: New test.
	* gfortran.dg/gomp/defaultmap-6.f90: New test.
	* gfortran.dg/gomp/defaultmap-7.f90: New test.
---
 gcc/fortran/dump-parse-tree.c | 38 +++++++++++++++--
 gcc/fortran/f95-lang.c        |  4 ++
 gcc/fortran/gfortran.h        | 26 +++++++++++-
 gcc/fortran/openmp.c          | 84 +++++++++++++++++++++++++++++++++++--
 gcc/fortran/trans-decl.c      |  5 +++
 gcc/fortran/trans-openmp.c    | 97 +++++++++++++++++++++++++++++++++++++++----
 gcc/fortran/trans.h           |  9 +++-
 7 files changed, 247 insertions(+), 16 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 141101e..07e98b7 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1751,7 +1751,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
     }
   if (omp_clauses->dist_sched_kind != OMP_SCHED_NONE)
     {
-      fprintf (dumpfile, " DIST_SCHEDULE (STATIC");
+      fputs (" DIST_SCHEDULE (STATIC", dumpfile);
       if (omp_clauses->dist_chunk_size)
 	{
 	  fputc (',', dumpfile);
@@ -1759,8 +1759,40 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
 	}
       fputc (')', dumpfile);
     }
-  if (omp_clauses->defaultmap)
-    fputs (" DEFALTMAP (TOFROM: SCALAR)", dumpfile);
+  for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
+    {
+      const char *dfltmap;
+      if (omp_clauses->defaultmap[i] == OMP_DEFAULTMAP_UNSET)
+	continue;
+      fputs (" DEFAULTMAP (", dumpfile);
+      switch (omp_clauses->defaultmap[i])
+	{
+	case OMP_DEFAULTMAP_ALLOC: dfltmap = "ALLOC"; break;
+	case OMP_DEFAULTMAP_TO: dfltmap = "TO"; break;
+	case OMP_DEFAULTMAP_FROM: dfltmap = "FROM"; break;
+	case OMP_DEFAULTMAP_TOFROM: dfltmap = "TOFROM"; break;
+	case OMP_DEFAULTMAP_FIRSTPRIVATE: dfltmap = "FIRSTPRIVATE"; break;
+	case OMP_DEFAULTMAP_NONE: dfltmap = "NONE"; break;
+	case OMP_DEFAULTMAP_DEFAULT: dfltmap = "DEFAULT"; break;
+	case OMP_DEFAULTMAP_PRESENT: dfltmap = "PRESENT"; break;
+	default: gcc_unreachable ();
+	}
+      fputs (dfltmap, dumpfile);
+      if (i != OMP_DEFAULTMAP_CAT_UNCATEGORIZED)
+	{
+	  fputc (':', dumpfile);
+	  switch ((enum gfc_omp_defaultmap) i)
+	    {
+	    case OMP_DEFAULTMAP_CAT_SCALAR: dfltmap = "SCALAR"; break;
+	    case OMP_DEFAULTMAP_CAT_AGGREGATE: dfltmap = "AGGREGATE"; break;
+	    case OMP_DEFAULTMAP_CAT_ALLOCATABLE: dfltmap = "ALLOCATABLE"; break;
+	    case OMP_DEFAULTMAP_CAT_POINTER: dfltmap = "POINTER"; break;
+	    default: gcc_unreachable ();
+	    }
+	  fputs (dfltmap, dumpfile);
+	}
+      fputc (')', dumpfile);
+    }
   if (omp_clauses->nogroup)
     fputs (" NOGROUP", dumpfile);
   if (omp_clauses->simd)
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index a346457..5fc8481 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -126,6 +126,8 @@ static const struct attribute_spec gfc_attribute_table[] =
 #undef LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR
 #undef LANG_HOOKS_OMP_CLAUSE_DTOR
 #undef LANG_HOOKS_OMP_FINISH_CLAUSE
+#undef LANG_HOOKS_OMP_ALLOCATABLE_P
+#undef LANG_HOOKS_OMP_SCALAR_TARGET_P
 #undef LANG_HOOKS_OMP_SCALAR_P
 #undef LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR
 #undef LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE
@@ -162,7 +164,9 @@ static const struct attribute_spec gfc_attribute_table[] =
 #define LANG_HOOKS_OMP_CLAUSE_LINEAR_CTOR	gfc_omp_clause_linear_ctor
 #define LANG_HOOKS_OMP_CLAUSE_DTOR		gfc_omp_clause_dtor
 #define LANG_HOOKS_OMP_FINISH_CLAUSE		gfc_omp_finish_clause
+#define LANG_HOOKS_OMP_ALLOCATABLE_P		gfc_omp_allocatable_p
 #define LANG_HOOKS_OMP_SCALAR_P			gfc_omp_scalar_p
+#define LANG_HOOKS_OMP_SCALAR_TARGET_P		gfc_omp_scalar_target_p
 #define LANG_HOOKS_OMP_DISREGARD_VALUE_EXPR	gfc_omp_disregard_value_expr
 #define LANG_HOOKS_OMP_PRIVATE_DEBUG_CLAUSE	gfc_omp_private_debug_clause
 #define LANG_HOOKS_OMP_PRIVATE_OUTER_REF	gfc_omp_private_outer_ref
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cbc95d3..f4a50d7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1241,6 +1241,29 @@ enum gfc_omp_map_op
   OMP_MAP_ALWAYS_TOFROM
 };
 
+enum gfc_omp_defaultmap
+{
+  OMP_DEFAULTMAP_UNSET,
+  OMP_DEFAULTMAP_ALLOC,
+  OMP_DEFAULTMAP_TO,
+  OMP_DEFAULTMAP_FROM,
+  OMP_DEFAULTMAP_TOFROM,
+  OMP_DEFAULTMAP_FIRSTPRIVATE,
+  OMP_DEFAULTMAP_NONE,
+  OMP_DEFAULTMAP_DEFAULT,
+  OMP_DEFAULTMAP_PRESENT
+};
+
+enum gfc_omp_defaultmap_category
+{
+  OMP_DEFAULTMAP_CAT_UNCATEGORIZED,
+  OMP_DEFAULTMAP_CAT_SCALAR,
+  OMP_DEFAULTMAP_CAT_AGGREGATE,
+  OMP_DEFAULTMAP_CAT_ALLOCATABLE,
+  OMP_DEFAULTMAP_CAT_POINTER,
+  OMP_DEFAULTMAP_CAT_NUM
+};
+
 enum gfc_omp_linear_op
 {
   OMP_LINEAR_DEFAULT,
@@ -1423,9 +1446,10 @@ typedef struct gfc_omp_clauses
   enum gfc_omp_device_type device_type;
   struct gfc_expr *chunk_size;
   enum gfc_omp_default_sharing default_sharing;
+  enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
   int collapse, orderedc;
   bool nowait, ordered, untied, mergeable;
-  bool inbranch, notinbranch, defaultmap, nogroup;
+  bool inbranch, notinbranch, nogroup;
   bool sched_simd, sched_monotonic, sched_nonmonotonic;
   bool simd, threads, depend_source, destroy, order_concurrent, capture;
   enum gfc_omp_atomic_op atomic_op;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 638a823..357a1e1 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1539,10 +1539,87 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		continue;
 	    }
 	  if ((mask & OMP_CLAUSE_DEFAULTMAP)
-	      && !c->defaultmap
-	      && gfc_match ("defaultmap ( tofrom : scalar )") == MATCH_YES)
+	      && gfc_match ("defaultmap ( ") == MATCH_YES)
 	    {
-	      c->defaultmap = true;
+	      enum gfc_omp_defaultmap behavior;
+	      gfc_omp_defaultmap_category category
+		= OMP_DEFAULTMAP_CAT_UNCATEGORIZED;
+	      if (gfc_match ("alloc ") == MATCH_YES)
+		behavior = OMP_DEFAULTMAP_ALLOC;
+	      else if (gfc_match ("tofrom ") == MATCH_YES)
+		behavior = OMP_DEFAULTMAP_TOFROM;
+	      else if (gfc_match ("to ") == MATCH_YES)
+		behavior = OMP_DEFAULTMAP_TO;
+	      else if (gfc_match ("from ") == MATCH_YES)
+		behavior = OMP_DEFAULTMAP_FROM;
+	      else if (gfc_match ("firstprivate ") == MATCH_YES)
+		behavior = OMP_DEFAULTMAP_FIRSTPRIVATE;
+	      else if (gfc_match ("none ") == MATCH_YES)
+		behavior = OMP_DEFAULTMAP_NONE;
+	      else if (gfc_match ("default ") == MATCH_YES)
+		behavior = OMP_DEFAULTMAP_DEFAULT;
+	      else
+		{
+		  gfc_error ("Expected ALLOC, TO, FROM, TOFROM, FIRSTPRIVATE, "
+			   "NONE or DEFAULT at %C");
+		  break;
+		}
+	      if (')' == gfc_peek_ascii_char ())
+		;
+	      else if (gfc_match (": ") != MATCH_YES)
+		break;
+	      else
+		{
+		  if (gfc_match ("scalar ") == MATCH_YES)
+		    category = OMP_DEFAULTMAP_CAT_SCALAR;
+		  else if (gfc_match ("aggregate ") == MATCH_YES)
+		    category = OMP_DEFAULTMAP_CAT_AGGREGATE;
+		  else if (gfc_match ("allocatable ") == MATCH_YES)
+		    category = OMP_DEFAULTMAP_CAT_ALLOCATABLE;
+		  else if (gfc_match ("pointer ") == MATCH_YES)
+		    category = OMP_DEFAULTMAP_CAT_POINTER;
+		  else
+		    {
+		      gfc_error ("Expected SCALAR, AGGREGATE, ALLOCATABLE or "
+				 "POINTER at %C");
+		      break;
+		    }
+		}
+	      for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; ++i)
+		{
+		  if (i != category
+		      && category != OMP_DEFAULTMAP_CAT_UNCATEGORIZED)
+		    continue;
+		  if (c->defaultmap[i] != OMP_DEFAULTMAP_UNSET)
+		    {
+		      const char *pcategory = NULL;
+		      switch (i)
+			{
+			case OMP_DEFAULTMAP_CAT_UNCATEGORIZED: break;
+			case OMP_DEFAULTMAP_CAT_SCALAR: pcategory = "SCALAR"; break;
+			case OMP_DEFAULTMAP_CAT_AGGREGATE:
+			  pcategory = "AGGREGATE";
+			  break;
+			case OMP_DEFAULTMAP_CAT_ALLOCATABLE:
+			  pcategory = "ALLOCATABLE";
+			  break;
+			case OMP_DEFAULTMAP_CAT_POINTER:
+			  pcategory = "POINTER";
+			  break;
+			default: gcc_unreachable ();
+			}
+		     if (i == OMP_DEFAULTMAP_CAT_UNCATEGORIZED)
+		      gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP with "
+				 "unspecified category");
+		     else
+		      gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP for "
+				 "category %s", pcategory);
+		     goto end;
+		    }
+		}
+	      c->defaultmap[category] = behavior;
+	      if (gfc_match (")") != MATCH_YES)
+		break;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_DELETE)
@@ -2459,6 +2536,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
       break;
     }
 
+end:
   if (gfc_match_omp_eos () != MATCH_YES)
     {
       if (!gfc_error_flag_test ())
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index c32bd05..479ba6f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -605,6 +605,11 @@ gfc_finish_decl_attrs (tree decl, symbol_attribute *attr)
 	  gfc_allocate_lang_decl (decl);
 	  GFC_DECL_SCALAR_POINTER (decl) = 1;
 	}
+      if (attr->target)
+	{
+	  gfc_allocate_lang_decl (decl);
+	  GFC_DECL_SCALAR_TARGET (decl) = 1;
+	}
     }
 }
 
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index f466ab6..ce1991e 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -393,6 +393,28 @@ gfc_is_unlimited_polymorphic_nonptr (tree type)
   return true;
 }
 
+/* Return true if the DECL is for an allocatable array or scalar.  */
+
+bool
+gfc_omp_allocatable_p (tree decl)
+{
+  if (!DECL_P (decl))
+    return false;
+
+  if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl))
+    return true;
+
+  tree type = TREE_TYPE (decl);
+  if (gfc_omp_privatize_by_reference (decl))
+    type = TREE_TYPE (type);
+
+  if (GFC_DESCRIPTOR_TYPE_P (type)
+      && GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
+    return true;
+
+  return false;
+}
+
 
 /* Return true if DECL in private clause needs
    OMP_CLAUSE_PRIVATE_OUTER_REF on the private clause.  */
@@ -1663,10 +1685,11 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc)
 
 
 /* Return true if DECL is a scalar variable (for the purpose of
-   implicit firstprivatization).  */
+   implicit firstprivatization/mapping). Only if 'ptr_alloc_ok.'
+   is true, allocatables and pointers are permitted. */
 
 bool
-gfc_omp_scalar_p (tree decl)
+gfc_omp_scalar_p (tree decl, bool ptr_alloc_ok)
 {
   tree type = TREE_TYPE (decl);
   if (TREE_CODE (type) == REFERENCE_TYPE)
@@ -1675,7 +1698,11 @@ gfc_omp_scalar_p (tree decl)
     {
       if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
 	  || GFC_DECL_GET_SCALAR_POINTER (decl))
-	type = TREE_TYPE (type);
+	{
+	  if (!ptr_alloc_ok)
+	    return false;
+	  type = TREE_TYPE (type);
+	}
       if (GFC_ARRAY_TYPE_P (type)
 	  || GFC_CLASS_TYPE_P (type))
 	return false;
@@ -1691,6 +1718,17 @@ gfc_omp_scalar_p (tree decl)
 }
 
 
+/* Return true if DECL is a scalar with target attribute but does not have the
+   allocatable (or pointer) attribute (for the purpose of implicit mapping).  */
+
+bool
+gfc_omp_scalar_target_p (tree decl)
+{
+  return (DECL_P (decl) && GFC_DECL_GET_SCALAR_TARGET (decl)
+	  && gfc_omp_scalar_p (decl, false));
+}
+
+
 /* Return true if DECL's DECL_VALUE_EXPR (if any) should be
    disregarded in OpenMP construct, because it is going to be
    remapped during OpenMP lowering.  SHARED is true if DECL
@@ -4036,13 +4074,55 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NOGROUP);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
-  if (clauses->defaultmap)
+
+  for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
     {
+      if (clauses->defaultmap[i] == OMP_DEFAULTMAP_UNSET)
+       continue;
+      enum omp_clause_defaultmap_kind behavior, category;
+      switch ((gfc_omp_defaultmap_category) i)
+	{
+	case OMP_DEFAULTMAP_CAT_UNCATEGORIZED:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_UNSPECIFIED;
+	  break;
+	case OMP_DEFAULTMAP_CAT_SCALAR:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR;
+	  break;
+	case OMP_DEFAULTMAP_CAT_AGGREGATE:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_AGGREGATE;
+	  break;
+	case OMP_DEFAULTMAP_CAT_ALLOCATABLE:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_ALLOCATABLE;
+	  break;
+	case OMP_DEFAULTMAP_CAT_POINTER:
+	  category = OMP_CLAUSE_DEFAULTMAP_CATEGORY_POINTER;
+	  break;
+	default: gcc_unreachable ();
+	}
+      switch (clauses->defaultmap[i])
+	{
+	case OMP_DEFAULTMAP_ALLOC:
+	  behavior = OMP_CLAUSE_DEFAULTMAP_ALLOC;
+	  break;
+	case OMP_DEFAULTMAP_TO: behavior = OMP_CLAUSE_DEFAULTMAP_TO; break;
+	case OMP_DEFAULTMAP_FROM: behavior = OMP_CLAUSE_DEFAULTMAP_FROM; break;
+	case OMP_DEFAULTMAP_TOFROM:
+	  behavior = OMP_CLAUSE_DEFAULTMAP_TOFROM;
+	  break;
+	case OMP_DEFAULTMAP_FIRSTPRIVATE:
+	  behavior = OMP_CLAUSE_DEFAULTMAP_FIRSTPRIVATE;
+	  break;
+	case OMP_DEFAULTMAP_NONE: behavior = OMP_CLAUSE_DEFAULTMAP_NONE; break;
+	case OMP_DEFAULTMAP_DEFAULT:
+	  behavior = OMP_CLAUSE_DEFAULTMAP_DEFAULT;
+	  break;
+	default: gcc_unreachable ();
+	}
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEFAULTMAP);
-      OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, OMP_CLAUSE_DEFAULTMAP_TOFROM,
-				      OMP_CLAUSE_DEFAULTMAP_CATEGORY_SCALAR);
+      OMP_CLAUSE_DEFAULTMAP_SET_KIND (c, behavior, category);
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
+
   if (clauses->depend_source)
     {
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEPEND);
@@ -5672,8 +5752,9 @@ gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR];
 	  clausesa[GFC_OMP_SPLIT_TARGET].device
 	    = code->ext.omp_clauses->device;
-	  clausesa[GFC_OMP_SPLIT_TARGET].defaultmap
-	    = code->ext.omp_clauses->defaultmap;
+	  for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
+	    clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i]
+	      = code->ext.omp_clauses->defaultmap[i];
 	  clausesa[GFC_OMP_SPLIT_TARGET].if_exprs[OMP_IF_TARGET]
 	    = code->ext.omp_clauses->if_exprs[OMP_IF_TARGET];
 	  /* And this is copied to all.  */
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index d1d4a1d..78578cf 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -823,7 +823,9 @@ tree gfc_omp_clause_assign_op (tree, tree, tree);
 tree gfc_omp_clause_linear_ctor (tree, tree, tree, tree);
 tree gfc_omp_clause_dtor (tree, tree);
 void gfc_omp_finish_clause (tree, gimple_seq *, bool);
-bool gfc_omp_scalar_p (tree);
+bool gfc_omp_allocatable_p (tree);
+bool gfc_omp_scalar_p (tree, bool);
+bool gfc_omp_scalar_target_p (tree);
 bool gfc_omp_disregard_value_expr (tree, bool);
 bool gfc_omp_private_debug_clause (tree, bool);
 bool gfc_omp_private_outer_ref (tree);
@@ -1030,6 +1032,7 @@ struct GTY(()) lang_decl {
   tree token, caf_offset;
   unsigned int scalar_allocatable : 1;
   unsigned int scalar_pointer : 1;
+  unsigned int scalar_target : 1;
   unsigned int optional_arg : 1;
 };
 
@@ -1044,12 +1047,16 @@ struct GTY(()) lang_decl {
   (DECL_LANG_SPECIFIC (node)->scalar_allocatable)
 #define GFC_DECL_SCALAR_POINTER(node) \
   (DECL_LANG_SPECIFIC (node)->scalar_pointer)
+#define GFC_DECL_SCALAR_TARGET(node) \
+  (DECL_LANG_SPECIFIC (node)->scalar_target)
 #define GFC_DECL_OPTIONAL_ARGUMENT(node) \
   (DECL_LANG_SPECIFIC (node)->optional_arg)
 #define GFC_DECL_GET_SCALAR_ALLOCATABLE(node) \
   (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_ALLOCATABLE (node) : 0)
 #define GFC_DECL_GET_SCALAR_POINTER(node) \
   (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_POINTER (node) : 0)
+#define GFC_DECL_GET_SCALAR_TARGET(node) \
+  (DECL_LANG_SPECIFIC (node) ? GFC_DECL_SCALAR_TARGET (node) : 0)
 #define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node)
 #define GFC_DECL_PARTIAL_PACKED_ARRAY(node) DECL_LANG_FLAG_1(node)
 #define GFC_DECL_ASSIGN(node) DECL_LANG_FLAG_2(node)
-- 
cgit v1.1


From ede6c3568f383f62df7bf9234212ee80763fdf6b Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 16 Jun 2021 00:17:05 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a0ee6eb..3c71933 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,22 @@
+2021-06-15  Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/92568
+	* dump-parse-tree.c (show_omp_clauses): Update for defaultmap.
+	* f95-lang.c (LANG_HOOKS_OMP_ALLOCATABLE_P,
+	LANG_HOOKS_OMP_SCALAR_TARGET_P): New.
+	* gfortran.h (enum gfc_omp_defaultmap,
+	enum gfc_omp_defaultmap_category): New.
+	* openmp.c (gfc_match_omp_clauses): Update defaultmap matching.
+	* trans-decl.c (gfc_finish_decl_attrs): Set GFC_DECL_SCALAR_TARGET.
+	* trans-openmp.c (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New.
+	(gfc_omp_scalar_p): Take 'ptr_alloc_ok' argument.
+	(gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for
+	defaultmap changes.
+	* trans.h (gfc_omp_scalar_p): Update prototype.
+	(gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New.
+	(struct lang_decl): Add scalar_target.
+	(GFC_DECL_SCALAR_TARGET, GFC_DECL_GET_SCALAR_TARGET): New.
+
 2021-06-14  Tobias Burnus  <tobias@codesourcery.com>
 
 	* resolve.c (resolve_variable): Remove *XCNEW used to
-- 
cgit v1.1


From 72e3d92178b44a3722519ec68e72e307443bda70 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 16 Jun 2021 21:54:16 +0200
Subject: Fortran - ICE in gfc_check_do_variable, at fortran/parse.c:4446

Avoid NULL pointer dereferences during error recovery.

gcc/fortran/ChangeLog:

	PR fortran/95501
	PR fortran/95502
	* expr.c (gfc_check_pointer_assign): Avoid NULL pointer
	dereference.
	* match.c (gfc_match_pointer_assignment): Likewise.
	* parse.c (gfc_check_do_variable): Avoid comparison with NULL
	symtree.

gcc/testsuite/ChangeLog:

	PR fortran/95501
	PR fortran/95502
	* gfortran.dg/pr95502.f90: New test.
---
 gcc/fortran/expr.c  | 15 +++++++++++++++
 gcc/fortran/match.c |  2 +-
 gcc/fortran/parse.c |  3 +++
 3 files changed, 19 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 956003e..6e663b4 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1683,10 +1683,21 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
 	  return false;
 	}
 
+#if 1
       cons = gfc_constructor_lookup (base, limit);
       gcc_assert (cons);
       gfc_constructor_append_expr (&expr->value.constructor,
 				   gfc_copy_expr (cons->expr), NULL);
+#else
+      cons = gfc_constructor_lookup (base, limit);
+      if (cons)
+	gfc_constructor_append_expr (&expr->value.constructor,
+				     gfc_copy_expr (cons->expr), NULL);
+      else
+	{
+	  t = false;
+	}
+#endif
     }
 
   mpz_clear (ptr);
@@ -3476,6 +3487,7 @@ gfc_specification_expr (gfc_expr *e)
     {
       gfc_error ("Expression at %L must be of INTEGER type, found %s",
 		 &e->where, gfc_basic_typename (e->ts.type));
+      gfc_clear_ts (&e->ts);
       return false;
     }
 
@@ -3815,6 +3827,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
   int proc_pointer;
   bool same_rank;
 
+  if (!lvalue->symtree)
+    return false;
+
   lhs_attr = gfc_expr_attr (lvalue);
   if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
     {
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 2946201..d148de3 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void)
   gfc_matching_procptr_assignment = 0;
 
   m = gfc_match (" %v =>", &lvalue);
-  if (m != MATCH_YES)
+  if (m != MATCH_YES || !lvalue->symtree)
     {
       m = MATCH_NO;
       goto cleanup;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0522b39..6d7845e 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4588,6 +4588,9 @@ gfc_check_do_variable (gfc_symtree *st)
 {
   gfc_state_data *s;
 
+  if (!st)
+    return 0;
+
   for (s=gfc_state_stack; s; s = s->previous)
     if (s->do_variable == st)
       {
-- 
cgit v1.1


From d117f992d81b783aa7cbff4c9fde9b96b70a93ed Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 16 Jun 2021 22:00:52 +0200
Subject: Revert "Fortran - ICE in gfc_check_do_variable, at
 fortran/parse.c:4446"

This reverts commit 72e3d92178b44a3722519ec68e72e307443bda70.
---
 gcc/fortran/expr.c  | 15 ---------------
 gcc/fortran/match.c |  2 +-
 gcc/fortran/parse.c |  3 ---
 3 files changed, 1 insertion(+), 19 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 6e663b4..956003e 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1683,21 +1683,10 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
 	  return false;
 	}
 
-#if 1
       cons = gfc_constructor_lookup (base, limit);
       gcc_assert (cons);
       gfc_constructor_append_expr (&expr->value.constructor,
 				   gfc_copy_expr (cons->expr), NULL);
-#else
-      cons = gfc_constructor_lookup (base, limit);
-      if (cons)
-	gfc_constructor_append_expr (&expr->value.constructor,
-				     gfc_copy_expr (cons->expr), NULL);
-      else
-	{
-	  t = false;
-	}
-#endif
     }
 
   mpz_clear (ptr);
@@ -3487,7 +3476,6 @@ gfc_specification_expr (gfc_expr *e)
     {
       gfc_error ("Expression at %L must be of INTEGER type, found %s",
 		 &e->where, gfc_basic_typename (e->ts.type));
-      gfc_clear_ts (&e->ts);
       return false;
     }
 
@@ -3827,9 +3815,6 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
   int proc_pointer;
   bool same_rank;
 
-  if (!lvalue->symtree)
-    return false;
-
   lhs_attr = gfc_expr_attr (lvalue);
   if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
     {
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index d148de3..2946201 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void)
   gfc_matching_procptr_assignment = 0;
 
   m = gfc_match (" %v =>", &lvalue);
-  if (m != MATCH_YES || !lvalue->symtree)
+  if (m != MATCH_YES)
     {
       m = MATCH_NO;
       goto cleanup;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 6d7845e..0522b39 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4588,9 +4588,6 @@ gfc_check_do_variable (gfc_symtree *st)
 {
   gfc_state_data *s;
 
-  if (!st)
-    return 0;
-
   for (s=gfc_state_stack; s; s = s->previous)
     if (s->do_variable == st)
       {
-- 
cgit v1.1


From cfe0a2ec26867b290eb84af00317e60f8b67455c Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 16 Jun 2021 22:04:22 +0200
Subject: Fortran - ICE in gfc_check_do_variable, at fortran/parse.c:4446

Avoid NULL pointer dereferences during error recovery.

gcc/fortran/ChangeLog:

	PR fortran/95501
	PR fortran/95502
	* expr.c (gfc_check_pointer_assign): Avoid NULL pointer
	dereference.
	* match.c (gfc_match_pointer_assignment): Likewise.
	* parse.c (gfc_check_do_variable): Avoid comparison with NULL
	symtree.

gcc/testsuite/ChangeLog:

	PR fortran/95501
	PR fortran/95502
	* gfortran.dg/pr95502.f90: New test.
---
 gcc/fortran/expr.c  | 3 +++
 gcc/fortran/match.c | 2 +-
 gcc/fortran/parse.c | 3 +++
 3 files changed, 7 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 956003e..b11ae7c 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3815,6 +3815,9 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
   int proc_pointer;
   bool same_rank;
 
+  if (!lvalue->symtree)
+    return false;
+
   lhs_attr = gfc_expr_attr (lvalue);
   if (lvalue->ts.type == BT_UNKNOWN && !lhs_attr.proc_pointer)
     {
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 2946201..d148de3 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1409,7 +1409,7 @@ gfc_match_pointer_assignment (void)
   gfc_matching_procptr_assignment = 0;
 
   m = gfc_match (" %v =>", &lvalue);
-  if (m != MATCH_YES)
+  if (m != MATCH_YES || !lvalue->symtree)
     {
       m = MATCH_NO;
       goto cleanup;
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0522b39..6d7845e 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4588,6 +4588,9 @@ gfc_check_do_variable (gfc_symtree *st)
 {
   gfc_state_data *s;
 
+  if (!st)
+    return 0;
+
   for (s=gfc_state_stack; s; s = s->previous)
     if (s->do_variable == st)
       {
-- 
cgit v1.1


From 9a61dfdb5ecb58bc4caea1c11e017d93bdd1d9a5 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 17 Jun 2021 00:16:54 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3c71933..f073f34 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,36 @@
+2021-06-16  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/95501
+	PR fortran/95502
+	* expr.c (gfc_check_pointer_assign): Avoid NULL pointer
+	dereference.
+	* match.c (gfc_match_pointer_assignment): Likewise.
+	* parse.c (gfc_check_do_variable): Avoid comparison with NULL
+	symtree.
+
+2021-06-16  Harald Anlauf  <anlauf@gmx.de>
+
+	Revert:
+	2021-06-16  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/95501
+	PR fortran/95502
+	* expr.c (gfc_check_pointer_assign): Avoid NULL pointer
+	dereference.
+	* match.c (gfc_match_pointer_assignment): Likewise.
+	* parse.c (gfc_check_do_variable): Avoid comparison with NULL
+	symtree.
+
+2021-06-16  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/95501
+	PR fortran/95502
+	* expr.c (gfc_check_pointer_assign): Avoid NULL pointer
+	dereference.
+	* match.c (gfc_match_pointer_assignment): Likewise.
+	* parse.c (gfc_check_do_variable): Avoid comparison with NULL
+	symtree.
+
 2021-06-15  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/92568
-- 
cgit v1.1


From 6fc543396345900f460c9fa7121239cb1ebbc3a3 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 18 Jun 2021 19:34:15 +0200
Subject: Fortran - fix conversion to result type for the min/max intrinsic

gcc/fortran/ChangeLog:

	PR fortran/100283
	PR fortran/101123
	* trans-intrinsic.c (gfc_conv_intrinsic_minmax): Unconditionally
	convert result of min/max to result type.

gcc/testsuite/ChangeLog:

	PR fortran/100283
	PR fortran/101123
	* gfortran.dg/min0_max0_1.f90: New test.
	* gfortran.dg/min0_max0_2.f90: New test.
---
 gcc/fortran/trans-intrinsic.c | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 73b0bcc..e578449 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -4147,10 +4147,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op)
 			build_empty_stmt (input_location));
       gfc_add_expr_to_block (&se->pre, tmp);
     }
-  if (TREE_CODE (type) == INTEGER_TYPE)
-    se->expr = fold_build1_loc (input_location, FIX_TRUNC_EXPR, type, mvar);
-  else
-    se->expr = convert (type, mvar);
+  se->expr = convert (type, mvar);
 }
 
 
-- 
cgit v1.1


From c5581d4842efff98060c6caf270c6f6c55e9888a Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 19 Jun 2021 00:16:33 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f073f34..e57f613 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-06-18  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100283
+	PR fortran/101123
+	* trans-intrinsic.c (gfc_conv_intrinsic_minmax): Unconditionally
+	convert result of min/max to result type.
+
 2021-06-16  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/95501
-- 
cgit v1.1


From da13e4ebebb07a47d5fb50eab8893f8fe38683df Mon Sep 17 00:00:00 2001
From: Andre Vehreschild <vehre@gcc.gnu.org>
Date: Wed, 23 Jun 2021 10:09:29 +0200
Subject: fortran: Fix deref of optional in gen. code. [PR100337]

gcc/fortran/ChangeLog:

	PR fortran/100337
	* trans-intrinsic.c (conv_co_collective): Check stat for null ptr
	before dereferrencing.

gcc/testsuite/ChangeLog:

	PR fortran/100337
	* gfortran.dg/coarray_collectives_17.f90: New test.
---
 gcc/fortran/trans-intrinsic.c | 24 ++++++++++++++++++++++--
 1 file changed, 22 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e578449..46670ba 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -11242,8 +11242,28 @@ conv_co_collective (gfc_code *code)
   if (flag_coarray == GFC_FCOARRAY_SINGLE)
     {
       if (stat != NULL_TREE)
-	gfc_add_modify (&block, stat,
-			fold_convert (TREE_TYPE (stat), integer_zero_node));
+	{
+	  /* For optional stats, check the pointer is valid before zero'ing.  */
+	  if (gfc_expr_attr (stat_expr).optional)
+	    {
+	      tree tmp;
+	      stmtblock_t ass_block;
+	      gfc_start_block (&ass_block);
+	      gfc_add_modify (&ass_block, stat,
+			      fold_convert (TREE_TYPE (stat),
+					    integer_zero_node));
+	      tmp = fold_build2 (NE_EXPR, logical_type_node,
+				 gfc_build_addr_expr (NULL_TREE, stat),
+				 null_pointer_node);
+	      tmp = fold_build3 (COND_EXPR, void_type_node, tmp,
+				 gfc_finish_block (&ass_block),
+				 build_empty_stmt (input_location));
+	      gfc_add_expr_to_block (&block, tmp);
+	    }
+	  else
+	    gfc_add_modify (&block, stat,
+			    fold_convert (TREE_TYPE (stat), integer_zero_node));
+	}
       return gfc_finish_block (&block);
     }
 
-- 
cgit v1.1


From cac3527793b38164e2a83c7ccbfe0cfcf5ac95b8 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Wed, 23 Jun 2021 22:10:43 +0200
Subject: fortran/dump-parse-tree.c: Use proper enum type

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Fix enum type used
	for dumping gfc_omp_defaultmap_category.
---
 gcc/fortran/dump-parse-tree.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 07e98b7..26841ee 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1781,7 +1781,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       if (i != OMP_DEFAULTMAP_CAT_UNCATEGORIZED)
 	{
 	  fputc (':', dumpfile);
-	  switch ((enum gfc_omp_defaultmap) i)
+	  switch ((enum gfc_omp_defaultmap_category) i)
 	    {
 	    case OMP_DEFAULTMAP_CAT_SCALAR: dfltmap = "SCALAR"; break;
 	    case OMP_DEFAULTMAP_CAT_AGGREGATE: dfltmap = "AGGREGATE"; break;
-- 
cgit v1.1


From fcf617f0d2a5a1b624718e07d7b219cb0234436f Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 24 Jun 2021 00:16:30 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 11 +++++++++++
 1 file changed, 11 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e57f613..aded48c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2021-06-23  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_omp_clauses): Fix enum type used
+	for dumping gfc_omp_defaultmap_category.
+
+2021-06-23  Andre Vehreschild  <vehre@gcc.gnu.org>
+
+	PR fortran/100337
+	* trans-intrinsic.c (conv_co_collective): Check stat for null ptr
+	before dereferrencing.
+
 2021-06-18  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/100283
-- 
cgit v1.1


From d5e69948beb61fb320d9ca703faff84d6f608545 Mon Sep 17 00:00:00 2001
From: Martin Sebor <msebor@redhat.com>
Date: Mon, 28 Jun 2021 14:47:21 -0600
Subject: fortran: Add support for per-location warning groups.

gcc/fortran/ChangeLog:

	* trans-array.c (trans_array_constructor): Replace direct uses
	of TREE_NO_WARNING with warning_suppressed_p, and suppress_warning.
	* trans-decl.c (gfc_build_qualified_array): Same.
	(gfc_build_dummy_array_decl): Same.
	(generate_local_decl): Same.
	(gfc_generate_function_code): Same.
	* trans-openmp.c (gfc_omp_clause_default_ctor): Same.
	(gfc_omp_clause_copy_ctor): Same.
	* trans-types.c (get_dtype_type_node): Same.
	(gfc_get_desc_dim_type): Same.
	(gfc_get_array_descriptor_base): Same.
	(gfc_get_caf_vector_type): Same.
	(gfc_get_caf_reference_type): Same.
	* trans.c (gfc_create_var_np): Same.
---
 gcc/fortran/trans-array.c  |  2 +-
 gcc/fortran/trans-decl.c   | 28 ++++++++--------
 gcc/fortran/trans-openmp.c |  4 +--
 gcc/fortran/trans-types.c  | 84 +++++++++++++++++++++++-----------------------
 gcc/fortran/trans.c        |  2 +-
 5 files changed, 60 insertions(+), 60 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a6bcd2b..0d013de 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2764,7 +2764,7 @@ trans_array_constructor (gfc_ss * ss, locus * where)
   desc = ss_info->data.array.descriptor;
   offset = gfc_index_zero_node;
   offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
-  TREE_NO_WARNING (offsetvar) = 1;
+  suppress_warning (offsetvar);
   TREE_USED (offsetvar) = 0;
   gfc_trans_array_constructor_value (&outer_loop->pre, type, desc, c,
 				     &offset, &offsetvar, dynamic);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 479ba6f..a73ce8a 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1045,7 +1045,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
 	{
 	  GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_LBOUND (type, dim));
 	}
       /* Don't try to use the unknown bound for assumed shape arrays.  */
       if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE
@@ -1053,13 +1053,13 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
 	      || dim < GFC_TYPE_ARRAY_RANK (type) - 1))
 	{
 	  GFC_TYPE_ARRAY_UBOUND (type, dim) = create_index_var ("ubound", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim));
 	}
 
       if (GFC_TYPE_ARRAY_STRIDE (type, dim) == NULL_TREE)
 	{
 	  GFC_TYPE_ARRAY_STRIDE (type, dim) = create_index_var ("stride", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_STRIDE (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_STRIDE (type, dim));
 	}
     }
   for (dim = GFC_TYPE_ARRAY_RANK (type);
@@ -1068,21 +1068,21 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       if (GFC_TYPE_ARRAY_LBOUND (type, dim) == NULL_TREE)
 	{
 	  GFC_TYPE_ARRAY_LBOUND (type, dim) = create_index_var ("lbound", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_LBOUND (type, dim));
 	}
       /* Don't try to use the unknown ubound for the last coarray dimension.  */
       if (GFC_TYPE_ARRAY_UBOUND (type, dim) == NULL_TREE
           && dim < GFC_TYPE_ARRAY_RANK (type) + GFC_TYPE_ARRAY_CORANK (type) - 1)
 	{
 	  GFC_TYPE_ARRAY_UBOUND (type, dim) = create_index_var ("ubound", nest);
-	  TREE_NO_WARNING (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 1;
+	  suppress_warning (GFC_TYPE_ARRAY_UBOUND (type, dim));
 	}
     }
   if (GFC_TYPE_ARRAY_OFFSET (type) == NULL_TREE)
     {
       GFC_TYPE_ARRAY_OFFSET (type) = gfc_create_var_np (gfc_array_index_type,
 							"offset");
-      TREE_NO_WARNING (GFC_TYPE_ARRAY_OFFSET (type)) = 1;
+      suppress_warning (GFC_TYPE_ARRAY_OFFSET (type));
 
       if (nest)
 	gfc_add_decl_to_parent_function (GFC_TYPE_ARRAY_OFFSET (type));
@@ -1094,7 +1094,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       && as->type != AS_ASSUMED_SIZE)
     {
       GFC_TYPE_ARRAY_SIZE (type) = create_index_var ("size", nest);
-      TREE_NO_WARNING (GFC_TYPE_ARRAY_SIZE (type)) = 1;
+      suppress_warning (GFC_TYPE_ARRAY_SIZE (type));
     }
 
   if (POINTER_TYPE_P (type))
@@ -1299,7 +1299,7 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy)
 
   /* Avoid uninitialized warnings for optional dummy arguments.  */
   if (sym->attr.optional)
-    TREE_NO_WARNING (decl) = 1;
+    suppress_warning (decl);
 
   /* We should never get deferred shape arrays here.  We used to because of
      frontend bugs.  */
@@ -5986,7 +5986,7 @@ generate_local_decl (gfc_symbol * sym)
 			     "does not have a default initializer",
 			     sym->name, &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING(sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	    }
 	  else if (warn_unused_dummy_argument)
 	    {
@@ -5996,7 +5996,7 @@ generate_local_decl (gfc_symbol * sym)
 			     &sym->declared_at);
 
 	      if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING(sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	    }
 	}
 
@@ -6012,7 +6012,7 @@ generate_local_decl (gfc_symbol * sym)
 			   "explicitly imported at %L", sym->name,
 			   &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING(sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	    }
 	  else if (!sym->attr.use_assoc)
 	    {
@@ -6030,7 +6030,7 @@ generate_local_decl (gfc_symbol * sym)
 			     "Unused variable %qs declared at %L",
 			     sym->name, &sym->declared_at);
 	      if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING(sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	    }
 	}
 
@@ -6145,7 +6145,7 @@ generate_local_decl (gfc_symbol * sym)
 	  /* Silence bogus "unused parameter" warnings from the
 	     middle end.  */
 	  if (sym->backend_decl != NULL_TREE)
-		TREE_NO_WARNING (sym->backend_decl) = 1;
+		suppress_warning (sym->backend_decl);
 	}
     }
 
@@ -6976,7 +6976,7 @@ gfc_generate_function_code (gfc_namespace * ns)
 			 "Return value of function %qs at %L not set",
 			 sym->name, &sym->declared_at);
 	  if (warn_return_type > 0)
-	    TREE_NO_WARNING(sym->backend_decl) = 1;
+	    suppress_warning (sym->backend_decl);
 	}
       if (result != NULL_TREE)
 	gfc_add_expr_to_block (&body, gfc_generate_return ());
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index ce1991e..ace4faf 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -785,7 +785,7 @@ gfc_omp_clause_default_ctor (tree clause, tree decl, tree outer)
 					 else_b));
       /* Avoid -W*uninitialized warnings.  */
       if (DECL_P (decl))
-	TREE_NO_WARNING (decl) = 1;
+	suppress_warning (decl, OPT_Wuninitialized);
     }
   else
     gfc_add_expr_to_block (&block, then_b);
@@ -970,7 +970,7 @@ gfc_omp_clause_copy_ctor (tree clause, tree dest, tree src)
 				     void_type_node, cond, then_b, else_b));
   /* Avoid -W*uninitialized warnings.  */
   if (DECL_P (dest))
-    TREE_NO_WARNING (dest) = 1;
+    suppress_warning (dest, OPT_Wuninitialized);
 
   return gfc_finish_block (&block);
 }
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 5582e40..d715838a 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -150,23 +150,23 @@ tree get_dtype_type_node (void)
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("elem_len"),
 					 size_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("version"),
 					 integer_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("rank"),
 					 signed_char_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("type"),
 					 signed_char_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       field = gfc_add_field_to_struct_1 (dtype_node,
 					 get_identifier ("attribute"),
 					 short_integer_type_node, &dtype_chain);
-      TREE_NO_WARNING (field) = 1;
+      suppress_warning (field);
       gfc_finish_type (dtype_node);
       TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (dtype_node)) = 1;
       dtype_type_node = dtype_node;
@@ -1453,17 +1453,17 @@ gfc_get_desc_dim_type (void)
   decl = gfc_add_field_to_struct_1 (type,
 				    get_identifier ("stride"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   decl = gfc_add_field_to_struct_1 (type,
 				    get_identifier ("lbound"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   decl = gfc_add_field_to_struct_1 (type,
 				    get_identifier ("ubound"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   /* Finish off the type.  */
   gfc_finish_type (type);
@@ -1853,19 +1853,19 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("offset"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   /* Add the dtype component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("dtype"),
 				    get_dtype_type_node (), &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   /* Add the span component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("span"),
 				    gfc_array_index_type, &chain);
-  TREE_NO_WARNING (decl) = 1;
+  suppress_warning (decl);
 
   /* Build the array type for the stride and bound components.  */
   if (dimen + codimen > 0)
@@ -1878,7 +1878,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
 
       decl = gfc_add_field_to_struct_1 (fat_type, get_identifier ("dim"),
 					arraytype, &chain);
-      TREE_NO_WARNING (decl) = 1;
+      suppress_warning (decl);
     }
 
   if (flag_coarray == GFC_FCOARRAY_LIB)
@@ -1886,7 +1886,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
       decl = gfc_add_field_to_struct_1 (fat_type,
 					get_identifier ("token"),
 					prvoid_type_node, &chain);
-      TREE_NO_WARNING (decl) = 1;
+      suppress_warning (decl);
     }
 
   /* Finish off the type.  */
@@ -2882,7 +2882,7 @@ copy_derived_types:
 	  token = gfc_find_component (derived, caf_name, true, true, NULL);
 	  gcc_assert (token);
 	  c->caf_token = token->backend_decl;
-	  TREE_NO_WARNING (c->caf_token) = 1;
+	  suppress_warning (c->caf_token);
 	}
     }
 
@@ -3547,11 +3547,11 @@ gfc_get_caf_vector_type (int dim)
       tmp = gfc_add_field_to_struct_1 (vect_struct_type,
 				       get_identifier ("vector"),
 				       pvoid_type_node, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (vect_struct_type,
 				       get_identifier ("kind"),
 				       integer_type_node, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       gfc_finish_type (vect_struct_type);
 
       chain = 0;
@@ -3559,34 +3559,34 @@ gfc_get_caf_vector_type (int dim)
       tmp = gfc_add_field_to_struct_1 (triplet_struct_type,
 				       get_identifier ("lower_bound"),
 				       gfc_array_index_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (triplet_struct_type,
 				       get_identifier ("upper_bound"),
 				       gfc_array_index_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (triplet_struct_type, get_identifier ("stride"),
 				       gfc_array_index_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       gfc_finish_type (triplet_struct_type);
 
       chain = 0;
       union_type = make_node (UNION_TYPE);
       tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("v"),
                                        vect_struct_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("triplet"),
 				       triplet_struct_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       gfc_finish_type (union_type);
 
       chain = 0;
       vec_type = make_node (RECORD_TYPE);
       tmp = gfc_add_field_to_struct_1 (vec_type, get_identifier ("nvec"),
 				       size_type_node, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       tmp = gfc_add_field_to_struct_1 (vec_type, get_identifier ("u"),
 				       union_type, &chain);
-      TREE_NO_WARNING (tmp) = 1;
+      suppress_warning (tmp);
       gfc_finish_type (vec_type);
       TYPE_NAME (vec_type) = get_identifier ("caf_vector_t");
     }
@@ -3613,11 +3613,11 @@ gfc_get_caf_reference_type ()
   tmp = gfc_add_field_to_struct_1 (c_struct_type,
 				   get_identifier ("offset"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (c_struct_type,
 				   get_identifier ("caf_token_offset"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (c_struct_type);
 
   chain = 0;
@@ -3625,15 +3625,15 @@ gfc_get_caf_reference_type ()
   tmp = gfc_add_field_to_struct_1 (s_struct_type,
 				   get_identifier ("start"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (s_struct_type,
 				   get_identifier ("end"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (s_struct_type,
 				   get_identifier ("stride"),
 				   gfc_array_index_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (s_struct_type);
 
   chain = 0;
@@ -3641,25 +3641,25 @@ gfc_get_caf_reference_type ()
   tmp = gfc_add_field_to_struct_1 (v_struct_type,
 				   get_identifier ("vector"),
 				   pvoid_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (v_struct_type,
 				   get_identifier ("nvec"),
 				   size_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (v_struct_type,
 				   get_identifier ("kind"),
 				   integer_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (v_struct_type);
 
   chain = 0;
   union_type = make_node (UNION_TYPE);
   tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("s"),
 				   s_struct_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (union_type, get_identifier ("v"),
 				   v_struct_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (union_type);
 
   tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node,
@@ -3674,40 +3674,40 @@ gfc_get_caf_reference_type ()
 						    gfc_index_zero_node,
 					 gfc_rank_cst[GFC_MAX_DIMENSIONS - 1])),
 		&chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (a_struct_type,
 				   get_identifier ("static_array_type"),
 				   integer_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (a_struct_type, get_identifier ("dim"),
 				   dim_union_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (a_struct_type);
 
   chain = 0;
   u_union_type = make_node (UNION_TYPE);
   tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("c"),
 				   c_struct_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (u_union_type, get_identifier ("a"),
 				   a_struct_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (u_union_type);
 
   chain = 0;
   reference_type = make_node (RECORD_TYPE);
   tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("next"),
 				   build_pointer_type (reference_type), &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("type"),
 				   integer_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("item_size"),
 				   size_type_node, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   tmp = gfc_add_field_to_struct_1 (reference_type, get_identifier ("u"),
 				   u_union_type, &chain);
-  TREE_NO_WARNING (tmp) = 1;
+  suppress_warning (tmp);
   gfc_finish_type (reference_type);
   TYPE_NAME (reference_type) = get_identifier ("caf_reference_t");
 
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index f26e91b..275d6a2 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -129,7 +129,7 @@ gfc_create_var_np (tree type, const char *prefix)
 
   /* No warnings for anonymous variables.  */
   if (prefix == NULL)
-    TREE_NO_WARNING (t) = 1;
+    suppress_warning (t);
 
   return t;
 }
-- 
cgit v1.1


From c8abc2058e96dd12454078d66be9982dfebfd154 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 29 Jun 2021 00:16:42 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aded48c..f9c97b0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,20 @@
+2021-06-28  Martin Sebor  <msebor@redhat.com>
+
+	* trans-array.c (trans_array_constructor): Replace direct uses
+	of TREE_NO_WARNING with warning_suppressed_p, and suppress_warning.
+	* trans-decl.c (gfc_build_qualified_array): Same.
+	(gfc_build_dummy_array_decl): Same.
+	(generate_local_decl): Same.
+	(gfc_generate_function_code): Same.
+	* trans-openmp.c (gfc_omp_clause_default_ctor): Same.
+	(gfc_omp_clause_copy_ctor): Same.
+	* trans-types.c (get_dtype_type_node): Same.
+	(gfc_get_desc_dim_type): Same.
+	(gfc_get_array_descriptor_base): Same.
+	(gfc_get_caf_vector_type): Same.
+	(gfc_get_caf_reference_type): Same.
+	* trans.c (gfc_create_var_np): Same.
+
 2021-06-23  Tobias Burnus  <tobias@codesourcery.com>
 
 	* dump-parse-tree.c (show_omp_clauses): Fix enum type used
-- 
cgit v1.1


From d7e3855d5dd8c001bb65dc7da1cda0249bfc2986 Mon Sep 17 00:00:00 2001
From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Tue, 6 Jul 2021 07:04:09 +0200
Subject: Do not replace variable op variable in I/O implied DO loop
 replacement.

This PR came about because index expressions of the form k+k in
implied DO loops in I/O statements were considered for replacement
by array slices.

Fixed by only doing the transformation if the expression is of the
type expr OP contastant.

gcc/fortran/ChangeLog:

	PR fortran/100227
	* frontend-passes.c (traverse_io_block): Adjust test for
	when a variable is eligible for the transformation to
	array slice.

gcc/testsuite/ChangeLog:

	PR fortran/100227
	* gfortran.dg/implied_do_io_7.f90: New test.
---
 gcc/fortran/frontend-passes.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 72a4e04..996dcc2 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -1299,8 +1299,8 @@ traverse_io_block (gfc_code *code, bool *has_reached, gfc_code *prev)
 		std::swap (start->value.op.op1, start->value.op.op2);
 	      gcc_fallthrough ();
 	    case INTRINSIC_MINUS:
-	      if ((start->value.op.op1->expr_type!= EXPR_VARIABLE
-		   && start->value.op.op2->expr_type != EXPR_CONSTANT)
+	      if (start->value.op.op1->expr_type!= EXPR_VARIABLE
+		  || start->value.op.op2->expr_type != EXPR_CONSTANT
 		  || start->value.op.op1->ref)
 		return false;
 	      if (!stack_top || !stack_top->iter
-- 
cgit v1.1


From 6fba0eea8d6464966ac6d37af98a7487a9a03d19 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 7 Jul 2021 00:17:12 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f9c97b0..3cf3e7d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-07-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/100227
+	* frontend-passes.c (traverse_io_block): Adjust test for
+	when a variable is eligible for the transformation to
+	array slice.
+
 2021-06-28  Martin Sebor  <msebor@redhat.com>
 
 	* trans-array.c (trans_array_constructor): Replace direct uses
-- 
cgit v1.1


From 269ca408e2839d7f3554a91515d73d4d95352f68 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 14 Jul 2021 17:25:29 +0200
Subject: Fortran - ICE in gfc_conv_expr_present initializing non-dummy class
 variable

gcc/fortran/ChangeLog:

	PR fortran/100949
	* trans-expr.c (gfc_trans_class_init_assign): Call
	gfc_conv_expr_present only for dummy variables.

gcc/testsuite/ChangeLog:

	PR fortran/100949
	* gfortran.dg/pr100949.f90: New test.
---
 gcc/fortran/trans-expr.c | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index de406ad..9e0dcde 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1741,8 +1741,9 @@ gfc_trans_class_init_assign (gfc_code *code)
 	}
     }
 
-  if (code->expr1->symtree->n.sym->attr.optional
-      || code->expr1->symtree->n.sym->ns->proc_name->attr.entry_master)
+  if (code->expr1->symtree->n.sym->attr.dummy
+      && (code->expr1->symtree->n.sym->attr.optional
+	  || code->expr1->symtree->n.sym->ns->proc_name->attr.entry_master))
     {
       tree present = gfc_conv_expr_present (code->expr1->symtree->n.sym);
       tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
-- 
cgit v1.1


From c4fee1c646d52a9001a53fa0d4072db86b9be791 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 15 Jul 2021 00:16:54 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3cf3e7d..5406c53 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-07-14  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100949
+	* trans-expr.c (gfc_trans_class_init_assign): Call
+	gfc_conv_expr_present only for dummy variables.
+
 2021-07-06  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/100227
-- 
cgit v1.1


From f527b8233498b40c8a2c616b82265f2e58aba42a Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 18 Jul 2021 21:35:53 +0200
Subject: Fortran: reject FORMAT tag of unknown type.

gcc/fortran/ChangeLog:

	PR fortran/101084
	* io.c (resolve_tag_format): Extend FORMAT check to unknown type.

gcc/testsuite/ChangeLog:

	PR fortran/101084
	* gfortran.dg/fmt_nonchar_3.f90: New test.
---
 gcc/fortran/io.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 40cd76e..fc97df7 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -1763,7 +1763,7 @@ resolve_tag_format (gfc_expr *e)
   if (e->ts.type != BT_CHARACTER)
     {
       if (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS
-	  || e->ts.type == BT_VOID)
+	  || e->ts.type == BT_VOID || e->ts.type == BT_UNKNOWN)
 	{
 	  gfc_error ("Non-character non-Hollerith in FORMAT tag at %L",
 		     &e->where);
-- 
cgit v1.1


From bdea84c4b5773723fa3ac7fa01f33542093864d5 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Mon, 19 Jul 2021 00:16:24 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5406c53..f1fe435 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2021-07-18  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/101084
+	* io.c (resolve_tag_format): Extend FORMAT check to unknown type.
+
 2021-07-14  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/100949
-- 
cgit v1.1


From b3d4011ba10275fbd5d6ec5a16d5aaebbdfb5d3c Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Wed, 21 Jul 2021 09:36:48 +0200
Subject: Fortran: Fix bind(C) character length checks

gcc/fortran/ChangeLog:

	* decl.c (gfc_verify_c_interop_param): Update for F2008 + F2018
	changes; reject unsupported bits with 'Error: Sorry,'.
	* trans-expr.c (gfc_conv_procedure_call): Fix condition to
	For using CFI descriptor with characters.

gcc/testsuite/ChangeLog:

	* gfortran.dg/iso_c_binding_char_1.f90: Update dg-error.
	* gfortran.dg/pr32599.f03: Use -std=-f2003 + update comment.
	* gfortran.dg/bind_c_char_10.f90: New test.
	* gfortran.dg/bind_c_char_6.f90: New test.
	* gfortran.dg/bind_c_char_7.f90: New test.
	* gfortran.dg/bind_c_char_8.f90: New test.
	* gfortran.dg/bind_c_char_9.f90: New test.
---
 gcc/fortran/decl.c       | 113 +++++++++++++++++++++++++++++++++++++++++++----
 gcc/fortran/trans-expr.c |  18 ++++----
 2 files changed, 112 insertions(+), 19 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 413c7a7..05081c4 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1552,20 +1552,115 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 	    }
 
           /* Character strings are only C interoperable if they have a
-             length of 1.  */
-          if (sym->ts.type == BT_CHARACTER && !sym->attr.dimension)
+	     length of 1.  However, as argument they are either iteroperable
+	     when passed as descriptor (which requires len=: or len=*) or
+	     when having a constant length or are always passed by
+	     descriptor.  */
+	  if (sym->ts.type == BT_CHARACTER)
 	    {
 	      gfc_charlen *cl = sym->ts.u.cl;
-	      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT
-                  || mpz_cmp_si (cl->length->value.integer, 1) != 0)
+
+	      if (sym->attr.allocatable || sym->attr.pointer)
 		{
-		  gfc_error ("Character argument %qs at %L "
-			     "must be length 1 because "
-			     "procedure %qs is BIND(C)",
-			     sym->name, &sym->declared_at,
-			     sym->ns->proc_name->name);
+		  /* F2018, 18.3.6 (6).  */
+		  if (!sym->ts.deferred)
+		    {
+		      if (sym->attr.allocatable)
+			gfc_error ("Allocatable character dummy argument %qs "
+				   "at %L must have deferred length as "
+				   "procedure %qs is BIND(C)", sym->name,
+				   &sym->declared_at, sym->ns->proc_name->name);
+		      else
+			gfc_error ("Pointer character dummy argument %qs at %L "
+				   "must have deferred length as procedure %qs "
+				   "is BIND(C)", sym->name, &sym->declared_at,
+				   sym->ns->proc_name->name);
+		      retval = false;
+		    }
+		  else if (!gfc_notify_std (GFC_STD_F2018,
+					    "Deferred-length character dummy "
+					    "argument %qs at %L of procedure "
+					    "%qs with BIND(C) attribute",
+					    sym->name, &sym->declared_at,
+					    sym->ns->proc_name->name))
+		    retval = false;
+		  else if (!sym->attr.dimension)
+		    {
+		      /* FIXME: Use CFI array descriptor for scalars.  */
+		      gfc_error ("Sorry, deferred-length scalar character dummy "
+				 "argument %qs at %L of procedure %qs with "
+				 "BIND(C) not yet supported", sym->name,
+				 &sym->declared_at, sym->ns->proc_name->name);
+		      retval = false;
+		    }
+		}
+	      else if (sym->attr.value
+		       && (!cl || !cl->length
+			   || cl->length->expr_type != EXPR_CONSTANT
+			   || mpz_cmp_si (cl->length->value.integer, 1) != 0))
+		{
+		  gfc_error ("Character dummy argument %qs at %L must be "
+			     "of length 1 as it has the VALUE attribute",
+			     sym->name, &sym->declared_at);
 		  retval = false;
 		}
+	      else if (!cl || !cl->length)
+		{
+		  /* Assumed length; F2018, 18.3.6 (5)(2).
+		     Uses the CFI array descriptor.  */
+		  if (!gfc_notify_std (GFC_STD_F2018,
+				      "Assumed-length character dummy argument "
+				      "%qs at %L of procedure %qs with BIND(C) "
+				      "attribute", sym->name, &sym->declared_at,
+				      sym->ns->proc_name->name))
+		    retval = false;
+		  else if (!sym->attr.dimension
+			   || sym->as->type == AS_ASSUMED_SIZE
+			   || sym->as->type == AS_EXPLICIT)
+		    {
+		      /* FIXME: Valid - should use the CFI array descriptor, but
+			 not yet handled for scalars and assumed-/explicit-size
+			 arrays.  */
+		      gfc_error ("Sorry, character dummy argument %qs at %L "
+				 "with assumed length is not yet supported for "
+				 "procedure %qs with BIND(C) attribute",
+				 sym->name, &sym->declared_at,
+				 sym->ns->proc_name->name);
+		      retval = false;
+		    }
+		}
+	      else if (cl->length->expr_type != EXPR_CONSTANT)
+		{
+		  /* F2018, 18.3.6, (5), item 4.  */
+		  if (!sym->attr.dimension
+		      || sym->as->type == AS_ASSUMED_SIZE
+		      || sym->as->type == AS_EXPLICIT)
+		    {
+		      gfc_error ("Character dummy argument %qs at %L must be "
+				 "of constant length or assumed length, "
+				 "unless it has assumed shape or assumed rank, "
+				 "as procedure %qs has the BIND(C) attribute",
+				 sym->name, &sym->declared_at,
+				 sym->ns->proc_name->name);
+		      retval = false;
+		    }
+		  else if (!gfc_notify_std (GFC_STD_F2018,
+					    "Character dummy argument %qs at "
+					    "%L with nonconstant length as "
+					    "procedure %qs is BIND(C)",
+					    sym->name, &sym->declared_at,
+					    sym->ns->proc_name->name))
+		    retval = false;
+		}
+	     else if (mpz_cmp_si (cl->length->value.integer, 1) != 0
+		      && !gfc_notify_std (GFC_STD_F2008,
+					  "Character dummy argument %qs at %L "
+					  "with length greater than 1 for "
+					  "procedure %qs with BIND(C) "
+					  "attribute",
+					  sym->name, &sym->declared_at,
+					  sym->ns->proc_name->name))
+	       retval = false;
 	    }
 
 	  /* We have to make sure that any param to a bind(c) routine does
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9e0dcde..b18a9ec 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5757,18 +5757,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
        arg = arg->next, formal = formal ? formal->next : NULL, ++argc)
     {
       bool finalized = false;
-      bool non_unity_length_string = false;
+      bool assumed_length_string = false;
       tree derived_array = NULL_TREE;
 
       e = arg->expr;
       fsym = formal ? formal->sym : NULL;
       parm_kind = MISSING;
 
-      if (fsym && fsym->ts.type == BT_CHARACTER && fsym->ts.u.cl
-	  && (!fsym->ts.u.cl->length
-	      || fsym->ts.u.cl->length->expr_type != EXPR_CONSTANT
-	      || mpz_cmp_si (fsym->ts.u.cl->length->value.integer, 1) != 0))
-	non_unity_length_string = true;
+      if (fsym && fsym->ts.type == BT_CHARACTER
+	  && (!fsym->ts.u.cl || !fsym->ts.u.cl->length))
+	assumed_length_string = true;
 
       /* If the procedure requires an explicit interface, the actual
 	 argument is passed according to the corresponding formal
@@ -6002,8 +6000,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
 	      else if (sym->attr.is_bind_c && e
 		       && (is_CFI_desc (fsym, NULL)
-			   || non_unity_length_string))
-		/* Implement F2018, C.12.6.1: paragraph (2).  */
+			   || assumed_length_string))
+		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
 	      else if (fsym && fsym->attr.value)
@@ -6447,8 +6445,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		}
 
 	      if (sym->attr.is_bind_c && e
-		  && (is_CFI_desc (fsym, NULL) || non_unity_length_string))
-		/* Implement F2018, C.12.6.1: paragraph (2).  */
+		  && (is_CFI_desc (fsym, NULL) || assumed_length_string))
+		/* Implement F2018, 18.3.6, list item (5), bullet point 2.  */
 		gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym);
 
 	      else if (e->expr_type == EXPR_VARIABLE
-- 
cgit v1.1


From c2b15fe27e6a0e42b108111d51acce69628593b4 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 21 Jul 2021 18:54:00 +0200
Subject: Fortran: ICE, OOM while calculating sizes of derived type array
 components

gcc/fortran/ChangeLog:

	PR fortran/101514
	* target-memory.c (gfc_interpret_derived): Size of array component
	of derived type can only be computed here for explicit shape.
	* trans-types.c (gfc_get_nodesc_array_type): Do not dereference
	NULL pointers.

gcc/testsuite/ChangeLog:

	PR fortran/101514
	* gfortran.dg/pr101514.f90: New test.
---
 gcc/fortran/target-memory.c | 3 +++
 gcc/fortran/trans-types.c   | 4 ++--
 2 files changed, 5 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index cfa8402..7b21a9e 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -534,6 +534,9 @@ gfc_interpret_derived (unsigned char *buffer, size_t buffer_size, gfc_expr *resu
 	{
 	  int n;
 
+	  if (cmp->as->type != AS_EXPLICIT)
+	    return 0;
+
 	  e->expr_type = EXPR_ARRAY;
 	  e->rank = cmp->as->rank;
 
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index d715838a..50fda43 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1644,7 +1644,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
       GFC_TYPE_ARRAY_STRIDE (type, n) = tmp;
 
       expr = as->lower[n];
-      if (expr->expr_type == EXPR_CONSTANT)
+      if (expr && expr->expr_type == EXPR_CONSTANT)
         {
           tmp = gfc_conv_mpz_to_tree (expr->value.integer,
 				      gfc_index_integer_kind);
@@ -1694,7 +1694,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
   for (n = as->rank; n < as->rank + as->corank; n++)
     {
       expr = as->lower[n];
-      if (expr->expr_type == EXPR_CONSTANT)
+      if (expr && expr->expr_type == EXPR_CONSTANT)
 	tmp = gfc_conv_mpz_to_tree (expr->value.integer,
 				    gfc_index_integer_kind);
       else
-- 
cgit v1.1


From a61f6afbee370785cf091fe46e2e022748528307 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Wed, 21 Jul 2021 18:30:00 +0200
Subject: OpenACC 'nohost' clause

Do not "compile a version of this procedure for the host".

	gcc/
	* tree-core.h (omp_clause_code): Add 'OMP_CLAUSE_NOHOST'.
	* tree.c (omp_clause_num_ops, omp_clause_code_name, walk_tree_1):
	Handle it.
	* tree-pretty-print.c (dump_omp_clause): Likewise.
	* omp-general.c (oacc_verify_routine_clauses): Likewise.
	* gimplify.c (gimplify_scan_omp_clauses)
	(gimplify_adjust_omp_clauses): Likewise.
	* tree-nested.c (convert_nonlocal_omp_clauses)
	(convert_local_omp_clauses): Likewise.
	* omp-low.c (scan_sharing_clauses): Likewise.
	* omp-offload.c (execute_oacc_device_lower): Update.
	gcc/c-family/
	* c-pragma.h (pragma_omp_clause): Add 'PRAGMA_OACC_CLAUSE_NOHOST'.
	gcc/c/
	* c-parser.c (c_parser_omp_clause_name): Handle 'nohost'.
	(c_parser_oacc_all_clauses): Handle 'PRAGMA_OACC_CLAUSE_NOHOST'.
	(OACC_ROUTINE_CLAUSE_MASK): Add 'PRAGMA_OACC_CLAUSE_NOHOST'.
	* c-typeck.c (c_finish_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'.
	gcc/cp/
	* parser.c (cp_parser_omp_clause_name): Handle 'nohost'.
	(cp_parser_oacc_all_clauses): Handle 'PRAGMA_OACC_CLAUSE_NOHOST'.
	(OACC_ROUTINE_CLAUSE_MASK): Add 'PRAGMA_OACC_CLAUSE_NOHOST'.
	* pt.c (tsubst_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'.
	* semantics.c (finish_omp_clauses): Likewise.
	gcc/fortran/
	* dump-parse-tree.c (show_attr): Update.
	* gfortran.h (symbol_attribute): Add 'oacc_routine_nohost' member.
	(gfc_omp_clauses): Add 'nohost' member.
	* module.c (ab_attribute): Add 'AB_OACC_ROUTINE_NOHOST'.
	(attr_bits, mio_symbol_attribute): Update.
	* openmp.c (omp_mask2): Add 'OMP_CLAUSE_NOHOST'.
	(gfc_match_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'.
	(OACC_ROUTINE_CLAUSES): Add 'OMP_CLAUSE_NOHOST'.
	(gfc_match_oacc_routine): Update.
	* trans-decl.c (add_attributes_to_decl): Update.
	* trans-openmp.c (gfc_trans_omp_clauses): Likewise.
	gcc/testsuite/
	* c-c++-common/goacc/classify-routine-nohost.c: New file.
	* c-c++-common/goacc/classify-routine.c: Update.
	* c-c++-common/goacc/routine-2.c: Likewise.
	* c-c++-common/goacc/routine-nohost-1.c: New file.
	* c-c++-common/goacc/routine-nohost-2.c: Likewise.
	* g++.dg/goacc/template.C: Update.
	* gfortran.dg/goacc/classify-routine-nohost.f95: New file.
	* gfortran.dg/goacc/classify-routine.f95: Update.
	* gfortran.dg/goacc/pure-elemental-procedures-2.f90: Likewise.
	* gfortran.dg/goacc/routine-6.f90: Likewise.
	* gfortran.dg/goacc/routine-intrinsic-2.f: Likewise.
	* gfortran.dg/goacc/routine-module-1.f90: Likewise.
	* gfortran.dg/goacc/routine-module-2.f90: Likewise.
	* gfortran.dg/goacc/routine-module-3.f90: Likewise.
	* gfortran.dg/goacc/routine-module-mod-1.f90: Likewise.
	* gfortran.dg/goacc/routine-multiple-directives-1.f90: Likewise.
	* gfortran.dg/goacc/routine-multiple-directives-2.f90: Likewise.
	libgomp/
	* testsuite/libgomp.oacc-c-c++-common/routine-nohost-1.c: New
	file.
	* testsuite/libgomp.oacc-c-c++-common/routine-nohost-2.c:
	Likewise.
	* testsuite/libgomp.oacc-c-c++-common/routine-nohost-2_2.c:
	Likewise.
	* testsuite/libgomp.oacc-fortran/routine-nohost-1.f90: Likewise.

Co-Authored-By: Joseph Myers <joseph@codesourcery.com>
Co-Authored-By: Cesar Philippidis <cesar@codesourcery.com>
---
 gcc/fortran/dump-parse-tree.c |  2 ++
 gcc/fortran/gfortran.h        |  2 ++
 gcc/fortran/module.c          |  7 +++++++
 gcc/fortran/openmp.c          | 30 +++++++++++++++++++++++++++---
 gcc/fortran/trans-decl.c      |  8 ++++++++
 gcc/fortran/trans-openmp.c    |  2 ++
 6 files changed, 48 insertions(+), 3 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 26841ee..8e4a101 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -926,6 +926,8 @@ show_attr (symbol_attribute *attr, const char * module)
     fputs (" ALWAYS-EXPLICIT", dumpfile);
   if (attr->is_main_program)
     fputs (" IS-MAIN-PROGRAM", dumpfile);
+  if (attr->oacc_routine_nohost)
+    fputs (" OACC-ROUTINE-NOHOST", dumpfile);
 
   /* FIXME: Still missing are oacc_routine_lop and ext_attr.  */
   fputc (')', dumpfile);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f4a50d7..921aed9 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -947,6 +947,7 @@ typedef struct
 
   /* OpenACC 'routine' directive's level of parallelism.  */
   ENUM_BITFIELD (oacc_routine_lop) oacc_routine_lop:3;
+  unsigned oacc_routine_nohost:1;
 
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
@@ -1488,6 +1489,7 @@ typedef struct gfc_omp_clauses
   unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
   unsigned par_auto:1, gang_static:1;
   unsigned if_present:1, finalize:1;
+  unsigned nohost:1;
   locus loc;
 }
 gfc_omp_clauses;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 321d3256..1804066 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2088,6 +2088,7 @@ enum ab_attribute
   AB_PDT_TEMPLATE, AB_PDT_ARRAY, AB_PDT_STRING,
   AB_OACC_ROUTINE_LOP_GANG, AB_OACC_ROUTINE_LOP_WORKER,
   AB_OACC_ROUTINE_LOP_VECTOR, AB_OACC_ROUTINE_LOP_SEQ,
+  AB_OACC_ROUTINE_NOHOST,
   AB_OMP_REQ_REVERSE_OFFLOAD, AB_OMP_REQ_UNIFIED_ADDRESS,
   AB_OMP_REQ_UNIFIED_SHARED_MEMORY, AB_OMP_REQ_DYNAMIC_ALLOCATORS,
   AB_OMP_REQ_MEM_ORDER_SEQ_CST, AB_OMP_REQ_MEM_ORDER_ACQ_REL,
@@ -2166,6 +2167,7 @@ static const mstring attr_bits[] =
     minit ("OACC_ROUTINE_LOP_WORKER", AB_OACC_ROUTINE_LOP_WORKER),
     minit ("OACC_ROUTINE_LOP_VECTOR", AB_OACC_ROUTINE_LOP_VECTOR),
     minit ("OACC_ROUTINE_LOP_SEQ", AB_OACC_ROUTINE_LOP_SEQ),
+    minit ("OACC_ROUTINE_NOHOST", AB_OACC_ROUTINE_NOHOST),
     minit ("OMP_REQ_REVERSE_OFFLOAD", AB_OMP_REQ_REVERSE_OFFLOAD),
     minit ("OMP_REQ_UNIFIED_ADDRESS", AB_OMP_REQ_UNIFIED_ADDRESS),
     minit ("OMP_REQ_UNIFIED_SHARED_MEMORY", AB_OMP_REQ_UNIFIED_SHARED_MEMORY),
@@ -2420,6 +2422,8 @@ mio_symbol_attribute (symbol_attribute *attr)
 	default:
 	  gcc_unreachable ();
 	}
+      if (attr->oacc_routine_nohost)
+	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_NOHOST, attr_bits);
 
       if (attr->flavor == FL_MODULE && gfc_current_ns->omp_requires)
 	{
@@ -2682,6 +2686,9 @@ mio_symbol_attribute (symbol_attribute *attr)
 	      verify_OACC_ROUTINE_LOP_NONE (attr->oacc_routine_lop);
 	      attr->oacc_routine_lop = OACC_ROUTINE_LOP_SEQ;
 	      break;
+	    case AB_OACC_ROUTINE_NOHOST:
+	      attr->oacc_routine_nohost = 1;
+	      break;
 	    case AB_OMP_REQ_REVERSE_OFFLOAD:
 	      gfc_omp_requires_add_clause (OMP_REQ_REVERSE_OFFLOAD,
 					   "reverse_offload",
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 357a1e1..520a435 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -880,6 +880,7 @@ enum omp_mask2
   OMP_CLAUSE_IF_PRESENT,
   OMP_CLAUSE_FINALIZE,
   OMP_CLAUSE_ATTACH,
+  OMP_CLAUSE_NOHOST,
   /* This must come last.  */
   OMP_MASK2_LAST
 };
@@ -2083,6 +2084,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      c->nogroup = needs_space = true;
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_NOHOST)
+	      && !c->nohost
+	      && gfc_match ("nohost") == MATCH_YES)
+	    {
+	      c->nohost = needs_space = true;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_NOTEMPORAL)
 	      && gfc_match_omp_variable_list ("nontemporal (",
 					      &c->lists[OMP_LIST_NONTEMPORAL],
@@ -2607,7 +2615,8 @@ end:
   omp_mask (OMP_CLAUSE_ASYNC)
 #define OACC_ROUTINE_CLAUSES \
   (omp_mask (OMP_CLAUSE_GANG) | OMP_CLAUSE_WORKER | OMP_CLAUSE_VECTOR	      \
-   | OMP_CLAUSE_SEQ)
+   | OMP_CLAUSE_SEQ							      \
+   | OMP_CLAUSE_NOHOST)
 
 
 static match
@@ -2936,6 +2945,7 @@ gfc_match_oacc_routine (void)
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
   oacc_routine_lop lop = OACC_ROUTINE_LOP_NONE;
+  bool nohost;
 
   old_loc = gfc_current_locus;
 
@@ -3012,6 +3022,7 @@ gfc_match_oacc_routine (void)
       gfc_error ("Multiple loop axes specified for routine at %C");
       goto cleanup;
     }
+  nohost = c ? c->nohost : false;
 
   if (isym != NULL)
     {
@@ -3024,6 +3035,13 @@ gfc_match_oacc_routine (void)
 		     " clause");
 	  goto cleanup;
 	}
+      /* ..., and no 'nohost' clause.  */
+      if (nohost)
+	{
+	  gfc_error ("Intrinsic symbol specified in !$ACC ROUTINE ( NAME )"
+		     " at %C marked with incompatible NOHOST clause");
+	  goto cleanup;
+	}
     }
   else if (sym != NULL)
     {
@@ -3037,7 +3055,9 @@ gfc_match_oacc_routine (void)
 	if (n_p->sym == sym)
 	  {
 	    add = false;
-	    if (lop != gfc_oacc_routine_lop (n_p->clauses))
+	    bool nohost_p = n_p->clauses ? n_p->clauses->nohost : false;
+	    if (lop != gfc_oacc_routine_lop (n_p->clauses)
+		|| nohost != nohost_p)
 	      {
 		gfc_error ("!$ACC ROUTINE already applied at %C");
 		goto cleanup;
@@ -3047,6 +3067,7 @@ gfc_match_oacc_routine (void)
       if (add)
 	{
 	  sym->attr.oacc_routine_lop = lop;
+	  sym->attr.oacc_routine_nohost = nohost;
 
 	  n = gfc_get_oacc_routine_name ();
 	  n->sym = sym;
@@ -3061,8 +3082,10 @@ gfc_match_oacc_routine (void)
       /* For a repeated OpenACC 'routine' directive, diagnose if it doesn't
 	 match the first one.  */
       oacc_routine_lop lop_p = gfc_current_ns->proc_name->attr.oacc_routine_lop;
+      bool nohost_p = gfc_current_ns->proc_name->attr.oacc_routine_nohost;
       if (lop_p != OACC_ROUTINE_LOP_NONE
-	  && lop != lop_p)
+	  && (lop != lop_p
+	      || nohost != nohost_p))
 	{
 	  gfc_error ("!$ACC ROUTINE already applied at %C");
 	  goto cleanup;
@@ -3073,6 +3096,7 @@ gfc_match_oacc_routine (void)
 				       &old_loc))
 	goto cleanup;
       gfc_current_ns->proc_name->attr.oacc_routine_lop = lop;
+      gfc_current_ns->proc_name->attr.oacc_routine_nohost = nohost;
     }
   else
     /* Something has gone wrong, possibly a syntax error.  */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index a73ce8a..bf8783a 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1473,6 +1473,14 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
       tree dims = oacc_build_routine_dims (clauses);
       list = oacc_replace_fn_attrib_attr (list, dims);
     }
+
+  if (sym_attr.oacc_routine_nohost)
+    {
+      tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_NOHOST);
+      OMP_CLAUSE_CHAIN (c) = clauses;
+      clauses = c;
+    }
+
   if (sym_attr.omp_device_type != OMP_DEVICE_TYPE_UNSET)
     {
       tree c = build_omp_clause (UNKNOWN_LOCATION, OMP_CLAUSE_DEVICE_TYPE);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index ace4faf..ac3f5f3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4297,6 +4297,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 	  gcc_unreachable ();
 	}
     }
+  /* OpenACC 'nohost' clauses cannot appear here.  */
+  gcc_checking_assert (!clauses->nohost);
 
   return nreverse (omp_clauses);
 }
-- 
cgit v1.1


From 419c6c68e60adc8801b44dab72ebcd680cfe1d97 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 22 Jul 2021 00:16:46 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f1fe435..1c6aa03 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,34 @@
+2021-07-21  Thomas Schwinge  <thomas@codesourcery.com>
+	    Joseph Myers  <joseph@codesourcery.com>
+	    Cesar Philippidis  <cesar@codesourcery.com>
+
+	* dump-parse-tree.c (show_attr): Update.
+	* gfortran.h (symbol_attribute): Add 'oacc_routine_nohost' member.
+	(gfc_omp_clauses): Add 'nohost' member.
+	* module.c (ab_attribute): Add 'AB_OACC_ROUTINE_NOHOST'.
+	(attr_bits, mio_symbol_attribute): Update.
+	* openmp.c (omp_mask2): Add 'OMP_CLAUSE_NOHOST'.
+	(gfc_match_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'.
+	(OACC_ROUTINE_CLAUSES): Add 'OMP_CLAUSE_NOHOST'.
+	(gfc_match_oacc_routine): Update.
+	* trans-decl.c (add_attributes_to_decl): Update.
+	* trans-openmp.c (gfc_trans_omp_clauses): Likewise.
+
+2021-07-21  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/101514
+	* target-memory.c (gfc_interpret_derived): Size of array component
+	of derived type can only be computed here for explicit shape.
+	* trans-types.c (gfc_get_nodesc_array_type): Do not dereference
+	NULL pointers.
+
+2021-07-21  Tobias Burnus  <tobias@codesourcery.com>
+
+	* decl.c (gfc_verify_c_interop_param): Update for F2008 + F2018
+	changes; reject unsupported bits with 'Error: Sorry,'.
+	* trans-expr.c (gfc_conv_procedure_call): Fix condition to
+	For using CFI descriptor with characters.
+
 2021-07-18  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/101084
-- 
cgit v1.1


From e314cfc371d8b2405a1d81e51b90f9fb24b9061f Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 23 Jul 2021 21:00:10 +0200
Subject: Fortran: extend check for array arguments and reject CLASS array
 elements.

gcc/fortran/ChangeLog:

	PR fortran/101536
	* check.c (array_check): Adjust check for the case of CLASS
	arrays.

gcc/testsuite/ChangeLog:

	PR fortran/101536
	* gfortran.dg/pr101536.f90: New test.
---
 gcc/fortran/check.c | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 27bf3a7..851af1b 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -731,12 +731,11 @@ logical_array_check (gfc_expr *array, int n)
 static bool
 array_check (gfc_expr *e, int n)
 {
-  if (e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok
+  if (e->rank != 0 && e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok
 	&& CLASS_DATA (e)->attr.dimension
 	&& CLASS_DATA (e)->as->rank)
     {
       gfc_add_class_array_ref (e);
-      return true;
     }
 
   if (e->rank != 0 && e->ts.type != BT_PROCEDURE)
-- 
cgit v1.1


From ead235f60139edc6eb408d8d083cbb15e417b447 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 24 Jul 2021 00:16:44 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1c6aa03..e3bf9d6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-07-23  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/101536
+	* check.c (array_check): Adjust check for the case of CLASS
+	arrays.
+
 2021-07-21  Thomas Schwinge  <thomas@codesourcery.com>
 	    Joseph Myers  <joseph@codesourcery.com>
 	    Cesar Philippidis  <cesar@codesourcery.com>
-- 
cgit v1.1


From 0cbf03689e3e7d9d6002b8e5d159ef3716d0404c Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 26 Jul 2021 14:20:46 +0200
Subject: PR fortran/93308/93963/94327/94331/97046 problems raised by
 descriptor handling
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Fortran: Fix attributes and bounds in ISO_Fortran_binding.

2021-07-26  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
	    Tobias Burnus  <tobias@codesourcery.com>

	PR fortran/93308
	PR fortran/93963
	PR fortran/94327
	PR fortran/94331
	PR fortran/97046

gcc/fortran/ChangeLog:

	* trans-decl.c (convert_CFI_desc): Only copy out the descriptor
	if necessary.
	* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute
	handling which reflect a previous intermediate version of the
	standard. Only copy out the descriptor if necessary.

libgfortran/ChangeLog:

	* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Add code
	to verify the descriptor. Correct bounds calculation.
	(gfc_desc_to_cfi_desc): Add code to verify the descriptor.

gcc/testsuite/ChangeLog:

	* gfortran.dg/ISO_Fortran_binding_1.f90: Add pointer attribute,
	this test is still erroneous but now it compiles.
	* gfortran.dg/bind_c_array_params_2.f90: Update regex to match
	code changes.
	* gfortran.dg/PR93308.f90: New test.
	* gfortran.dg/PR93963.f90: New test.
	* gfortran.dg/PR94327.c: New test.
	* gfortran.dg/PR94327.f90: New test.
	* gfortran.dg/PR94331.c: New test.
	* gfortran.dg/PR94331.f90: New test.
	* gfortran.dg/PR97046.f90: New test.
---
 gcc/fortran/trans-decl.c | 32 +++++++++++++++++++-------------
 gcc/fortran/trans-expr.c | 24 ++++++++++++++----------
 2 files changed, 33 insertions(+), 23 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index bf8783a..784f7b6 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -4539,22 +4539,28 @@ convert_CFI_desc (gfc_wrapped_block * block, gfc_symbol *sym)
       gfc_add_expr_to_block (&outer_block, incoming);
       incoming = gfc_finish_block (&outer_block);
 
-
       /* Convert the gfc descriptor back to the CFI type before going
 	 out of scope, if the CFI type was present at entry.  */
-      gfc_init_block (&outer_block);
-      gfc_init_block (&tmpblock);
-
-      tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
-      outgoing = build_call_expr_loc (input_location,
-			gfor_fndecl_gfc_to_cfi, 2, tmp, gfc_desc_ptr);
-      gfc_add_expr_to_block (&tmpblock, outgoing);
+      outgoing = NULL_TREE;
+      if ((sym->attr.pointer || sym->attr.allocatable)
+	  && !sym->attr.value
+	  && sym->attr.intent != INTENT_IN)
+	{
+	  gfc_init_block (&outer_block);
+	  gfc_init_block (&tmpblock);
 
-      outgoing = build3_v (COND_EXPR, present,
-			   gfc_finish_block (&tmpblock),
-			   build_empty_stmt (input_location));
-      gfc_add_expr_to_block (&outer_block, outgoing);
-      outgoing = gfc_finish_block (&outer_block);
+	  tmp = gfc_build_addr_expr (ppvoid_type_node, CFI_desc_ptr);
+	  outgoing = build_call_expr_loc (input_location,
+					  gfor_fndecl_gfc_to_cfi, 2,
+					  tmp, gfc_desc_ptr);
+	  gfc_add_expr_to_block (&tmpblock, outgoing);
+
+	  outgoing = build3_v (COND_EXPR, present,
+			       gfc_finish_block (&tmpblock),
+			       build_empty_stmt (input_location));
+	  gfc_add_expr_to_block (&outer_block, outgoing);
+	  outgoing = gfc_finish_block (&outer_block);
+	}
 
       /* Add the lot to the procedure init and finally blocks.  */
       gfc_add_init_cleanup (block, incoming, outgoing);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b18a9ec..c4291cc 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5502,13 +5502,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
 	attribute = 1;
     }
 
-  /* If the formal argument is assumed shape and neither a pointer nor
-     allocatable, it is unconditionally CFI_attribute_other.  */
-  if (fsym->as->type == AS_ASSUMED_SHAPE
-      && !fsym->attr.pointer && !fsym->attr.allocatable)
-   cfi_attribute = 2;
+  if (fsym->attr.pointer)
+    cfi_attribute = 0;
+  else if (fsym->attr.allocatable)
+    cfi_attribute = 1;
   else
-   cfi_attribute = attribute;
+    cfi_attribute = 2;
 
   if (e->rank != 0)
     {
@@ -5616,10 +5615,15 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
   gfc_prepend_expr_to_block (&parmse->post, tmp);
 
   /* Transfer values back to gfc descriptor.  */
-  tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
-  tmp = build_call_expr_loc (input_location,
-			     gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
-  gfc_prepend_expr_to_block (&parmse->post, tmp);
+  if (cfi_attribute != 2  /* CFI_attribute_other.  */
+      && !fsym->attr.value
+      && fsym->attr.intent != INTENT_IN)
+    {
+      tmp = gfc_build_addr_expr (NULL_TREE, parmse->expr);
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_cfi_to_gfc, 2, gfc_desc_ptr, tmp);
+      gfc_prepend_expr_to_block (&parmse->post, tmp);
+    }
 
   /* Deal with an optional dummy being passed to an optional formal arg
      by finishing the pre and post blocks and making their execution
-- 
cgit v1.1


From 1a7febe9432f5302620aebc9cb5760c6c1d31d4c Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 27 Jul 2021 00:16:27 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e3bf9d6..af9f6b5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2021-07-26  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
+	    Tobias Burnus  <tobias@codesourcery.com>
+
+	PR fortran/93308
+	PR fortran/93963
+	PR fortran/94327
+	PR fortran/94331
+	PR fortran/97046
+	* trans-decl.c (convert_CFI_desc): Only copy out the descriptor
+	if necessary.
+	* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute
+	handling which reflect a previous intermediate version of the
+	standard. Only copy out the descriptor if necessary.
+
 2021-07-23  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/101536
-- 
cgit v1.1


From 7bf582e6cfcef922a087b1b2b42aa04ea9cb2d94 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 28 Jul 2021 19:11:27 +0200
Subject: Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument

gcc/fortran/ChangeLog:

	PR fortran/101564
	* expr.c (gfc_check_vardef_context): Add check for KIND and LEN
	parameter inquiries.
	* match.c (gfc_match): Fix comment for %v code.
	(gfc_match_allocate, gfc_match_deallocate): Replace use of %v code
	by %e in gfc_match to allow for function references as STAT and
	ERRMSG arguments.
	* resolve.c (resolve_allocate_deallocate): Avoid NULL pointer
	dereferences and shortcut for bad STAT and ERRMSG argument to
	(DE)ALLOCATE.  Remove bogus parts of checks for STAT and ERRMSG.

gcc/testsuite/ChangeLog:

	PR fortran/101564
	* gfortran.dg/allocate_stat_3.f90: New test.
	* gfortran.dg/allocate_stat.f90: Adjust error messages.
	* gfortran.dg/implicit_11.f90: Likewise.
	* gfortran.dg/inquiry_type_ref_3.f90: Likewise.
---
 gcc/fortran/expr.c    | 10 ++++++++++
 gcc/fortran/match.c   | 11 ++++++-----
 gcc/fortran/resolve.c | 35 ++++++++++++++++++++++++-----------
 3 files changed, 40 insertions(+), 16 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b11ae7c..35563a7 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -6199,6 +6199,16 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	  if (!pointer)
 	    check_intentin = false;
 	}
+      if (ref->type == REF_INQUIRY
+	  && (ref->u.i == INQUIRY_KIND || ref->u.i == INQUIRY_LEN))
+	{
+	  if (context)
+	    gfc_error ("%qs parameter inquiry for %qs in "
+		       "variable definition context (%s) at %L",
+		       ref->u.i == INQUIRY_KIND ? "KIND" : "LEN",
+		       sym->name, context, &e->where);
+	  return false;
+	}
     }
 
   if (check_intentin
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index d148de3..b110548 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1109,7 +1109,8 @@ gfc_match_char (char c)
    %t  Matches end of statement.
    %o  Matches an intrinsic operator, returned as an INTRINSIC enum.
    %l  Matches a statement label
-   %v  Matches a variable expression (an lvalue)
+   %v  Matches a variable expression (an lvalue, except function references
+   having a data pointer result)
    %   Matches a required space (in free form) and optional spaces.  */
 
 match
@@ -4405,7 +4406,7 @@ gfc_match_allocate (void)
 
 alloc_opt_list:
 
-      m = gfc_match (" stat = %v", &tmp);
+      m = gfc_match (" stat = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4434,7 +4435,7 @@ alloc_opt_list:
 	    goto alloc_opt_list;
 	}
 
-      m = gfc_match (" errmsg = %v", &tmp);
+      m = gfc_match (" errmsg = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4777,7 +4778,7 @@ gfc_match_deallocate (void)
 
 dealloc_opt_list:
 
-      m = gfc_match (" stat = %v", &tmp);
+      m = gfc_match (" stat = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4799,7 +4800,7 @@ dealloc_opt_list:
 	    goto dealloc_opt_list;
 	}
 
-      m = gfc_match (" errmsg = %v", &tmp);
+      m = gfc_match (" errmsg = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 45c3ad3..5923646 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8155,16 +8155,21 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
   /* Check the stat variable.  */
   if (stat)
     {
-      gfc_check_vardef_context (stat, false, false, false,
-				_("STAT variable"));
+      if (!gfc_check_vardef_context (stat, false, false, false,
+				     _("STAT variable")))
+	  goto done_stat;
 
-      if ((stat->ts.type != BT_INTEGER
-	   && !(stat->ref && (stat->ref->type == REF_ARRAY
-			      || stat->ref->type == REF_COMPONENT)))
+      if (stat->ts.type != BT_INTEGER
 	  || stat->rank > 0)
 	gfc_error ("Stat-variable at %L must be a scalar INTEGER "
 		   "variable", &stat->where);
 
+      if (stat->expr_type == EXPR_CONSTANT || stat->symtree == NULL)
+	goto done_stat;
+
+      /* F2018:9.7.4: The stat-variable shall not be allocated or deallocated
+       * within the ALLOCATE or DEALLOCATE statement in which it appears ...
+       */
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
 	  {
@@ -8192,6 +8197,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	  }
     }
 
+done_stat:
+
   /* Check the errmsg variable.  */
   if (errmsg)
     {
@@ -8199,22 +8206,26 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	gfc_warning (0, "ERRMSG at %L is useless without a STAT tag",
 		     &errmsg->where);
 
-      gfc_check_vardef_context (errmsg, false, false, false,
-				_("ERRMSG variable"));
+      if (!gfc_check_vardef_context (errmsg, false, false, false,
+				     _("ERRMSG variable")))
+	  goto done_errmsg;
 
       /* F18:R928  alloc-opt             is ERRMSG = errmsg-variable
 	 F18:R930  errmsg-variable       is scalar-default-char-variable
 	 F18:R906  default-char-variable is variable
 	 F18:C906  default-char-variable shall be default character.  */
-      if ((errmsg->ts.type != BT_CHARACTER
-	   && !(errmsg->ref
-		&& (errmsg->ref->type == REF_ARRAY
-		    || errmsg->ref->type == REF_COMPONENT)))
+      if (errmsg->ts.type != BT_CHARACTER
 	  || errmsg->rank > 0
 	  || errmsg->ts.kind != gfc_default_character_kind)
 	gfc_error ("ERRMSG variable at %L shall be a scalar default CHARACTER "
 		   "variable", &errmsg->where);
 
+      if (errmsg->expr_type == EXPR_CONSTANT || errmsg->symtree == NULL)
+	goto done_errmsg;
+
+      /* F2018:9.7.5: The errmsg-variable shall not be allocated or deallocated
+       * within the ALLOCATE or DEALLOCATE statement in which it appears ...
+       */
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name)
 	  {
@@ -8242,6 +8253,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	  }
     }
 
+done_errmsg:
+
   /* Check that an allocate-object appears only once in the statement.  */
 
   for (p = code->ext.alloc.list; p; p = p->next)
-- 
cgit v1.1


From 3916902930769d5172c0feaa5f535ca7b2bafdf7 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 29 Jul 2021 00:16:43 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index af9f6b5..c757bf0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2021-07-28  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/101564
+	* expr.c (gfc_check_vardef_context): Add check for KIND and LEN
+	parameter inquiries.
+	* match.c (gfc_match): Fix comment for %v code.
+	(gfc_match_allocate, gfc_match_deallocate): Replace use of %v code
+	by %e in gfc_match to allow for function references as STAT and
+	ERRMSG arguments.
+	* resolve.c (resolve_allocate_deallocate): Avoid NULL pointer
+	dereferences and shortcut for bad STAT and ERRMSG argument to
+	(DE)ALLOCATE.  Remove bogus parts of checks for STAT and ERRMSG.
+
 2021-07-26  José Rui Faustino de Sousa  <jrfsousa@gmail.com>
 	    Tobias Burnus  <tobias@codesourcery.com>
 
-- 
cgit v1.1


From cd754efa9a5349c693919046b8be074395ea114e Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 7 Aug 2021 20:30:32 +0200
Subject: Fortran: ICE with automatic character object, save, and various
 options

gcc/fortran/ChangeLog:

	PR fortran/68568
	* primary.c (gfc_expr_attr): Variable attribute can only be
	inquired when symtree is non-NULL.
---
 gcc/fortran/primary.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 9fe8d1e..56a78d6 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -2779,7 +2779,7 @@ gfc_expr_attr (gfc_expr *e)
 	       && e->value.function.isym->transformational
 	       && e->ts.type == BT_CLASS)
 	attr = CLASS_DATA (e)->attr;
-      else
+      else if (e->symtree)
 	attr = gfc_variable_attr (e, NULL);
 
       /* TODO: NULL() returns pointers.  May have to take care of this
-- 
cgit v1.1


From 7b51202c2a02c24e70b1924d468186130b2c09b7 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sun, 8 Aug 2021 00:16:32 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c757bf0..2e7a9ad 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-08-07  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/68568
+	* primary.c (gfc_expr_attr): Variable attribute can only be
+	inquired when symtree is non-NULL.
+
 2021-07-28  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/101564
-- 
cgit v1.1


From e8426554e1375fec2d119ba9cc5feb263db84559 Mon Sep 17 00:00:00 2001
From: Richard Biener <rguenther@suse.de>
Date: Mon, 9 Aug 2021 13:12:08 +0200
Subject: Adjust volatile handling of the operand scanner

The GIMPLE SSA operand scanner handles COMPONENT_REFs that are
not marked TREE_THIS_VOLATILE but have a TREE_THIS_VOLATILE
FIELD_DECL as volatile.  That's inconsistent in how TREE_THIS_VOLATILE
testing on GENERIC refs works which requires operand zero of
component references to mirror TREE_THIS_VOLATILE to the ref
so that testing TREE_THIS_VOLATILE on the outermost reference
is enough to determine the volatileness.

The following patch thus removes FIELD_DECL scanning from
the GIMPLE SSA operand scanner, possibly leaving fewer stmts
marked as gimple_has_volatile_ops.

It shows we miss at least one case in the fortran frontend, though
there's a suspicious amount of COMPONENT_REF creation compared
to little setting of TREE_THIS_VOLATILE.  This fixes the FAIL
of gfortran.dg/volatile11.f90 that would otherwise occur.

Visually inspecting fortran/ reveals a bunch of likely to fix
cases but I don't know the constraints of 'volatile' uses in
the fortran language to assess whether some of these are not
necessary.

2021-08-09  Richard Biener  <rguenther@suse.de>

gcc/
	* tree-ssa-operands.c (operands_scanner::get_expr_operands):
	Do not look at COMPONENT_REF FIELD_DECLs TREE_THIS_VOLATILE
	to determine has_volatile_ops.

gcc/fortran/
	* trans-common.c (create_common): Set TREE_THIS_VOLATILE on the
	COMPONENT_REF if the field is volatile.
---
 gcc/fortran/trans-common.c | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index a11cf4c..7bcf18d 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -759,10 +759,11 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
       else
 	gfc_add_decl_to_function (var_decl);
 
-      SET_DECL_VALUE_EXPR (var_decl,
-			   fold_build3_loc (input_location, COMPONENT_REF,
-					    TREE_TYPE (s->field),
-					    decl, s->field, NULL_TREE));
+      tree comp = build3_loc (input_location, COMPONENT_REF,
+			      TREE_TYPE (s->field), decl, s->field, NULL_TREE);
+      if (TREE_THIS_VOLATILE (s->field))
+	TREE_THIS_VOLATILE (comp) = 1;
+      SET_DECL_VALUE_EXPR (var_decl, comp);
       DECL_HAS_VALUE_EXPR_P (var_decl) = 1;
       GFC_DECL_COMMON_OR_EQUIV (var_decl) = 1;
 
-- 
cgit v1.1


From 58340a7cd3670024bafdbbc6ca63a9af841df98a Mon Sep 17 00:00:00 2001
From: Sandra Loosemore <sandra@codesourcery.com>
Date: Tue, 3 Aug 2021 16:21:16 -0700
Subject: Fortran: Fix c_float128 and c_float128_complex definitions.

gfc_float128_type_node is only non-NULL on targets that support a
128-bit type that is not long double.  Use float128_type_node instead
when computing the value of the kind constants c_float128 and
c_float128_complex from the ISO_C_BINDING intrinsic module; this also
ensures it actually corresponds to __float128 (the IEEE encoding) and
not some other 128-bit floating-point type.

2021-08-11  Sandra Loosemore  <sandra@codesourcery.com>

gcc/fortran/
	* iso-c-binding.def (c_float128, c_float128_complex): Check
	float128_type_node instead of gfc_float128_type_node.
	* trans-types.c (gfc_init_kinds, gfc_build_real_type):
	Update comments re supported 128-bit floating-point types.
---
 gcc/fortran/iso-c-binding.def | 15 +++++++++++----
 gcc/fortran/trans-types.c     | 12 ++++++++++--
 2 files changed, 21 insertions(+), 6 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/iso-c-binding.def b/gcc/fortran/iso-c-binding.def
index 8bf69ef..e65c750 100644
--- a/gcc/fortran/iso-c-binding.def
+++ b/gcc/fortran/iso-c-binding.def
@@ -114,9 +114,14 @@ NAMED_REALCST (ISOCBINDING_DOUBLE, "c_double", \
                get_real_kind_from_node (double_type_node), GFC_STD_F2003)
 NAMED_REALCST (ISOCBINDING_LONG_DOUBLE, "c_long_double", \
                get_real_kind_from_node (long_double_type_node), GFC_STD_F2003)
+
+/* GNU Extension.  Note that the equivalence here is specifically to
+   the IEEE 128-bit type __float128; if that does not map onto a type
+   otherwise supported by the Fortran front end, get_real_kind_from_node
+   will reject it as unsupported.  */
 NAMED_REALCST (ISOCBINDING_FLOAT128, "c_float128", \
-	       gfc_float128_type_node == NULL_TREE \
-		  ? -4 : get_real_kind_from_node (gfc_float128_type_node), \
+		(float128_type_node == NULL_TREE \
+		 ? -4 : get_real_kind_from_node (float128_type_node)), \
 	       GFC_STD_GNU)
 NAMED_CMPXCST (ISOCBINDING_FLOAT_COMPLEX, "c_float_complex", \
                get_real_kind_from_node (float_type_node), GFC_STD_F2003)
@@ -124,9 +129,11 @@ NAMED_CMPXCST (ISOCBINDING_DOUBLE_COMPLEX, "c_double_complex", \
                get_real_kind_from_node (double_type_node), GFC_STD_F2003)
 NAMED_CMPXCST (ISOCBINDING_LONG_DOUBLE_COMPLEX, "c_long_double_complex", \
                get_real_kind_from_node (long_double_type_node), GFC_STD_F2003)
+
+/* GNU Extension.  Similar issues to c_float128 above.  */
 NAMED_CMPXCST (ISOCBINDING_FLOAT128_COMPLEX, "c_float128_complex", \
-	       gfc_float128_type_node == NULL_TREE \
-		  ? -4 : get_real_kind_from_node (gfc_float128_type_node), \
+		(float128_type_node == NULL_TREE \
+		 ? -4 : get_real_kind_from_node (float128_type_node)), \
 	       GFC_STD_GNU)
 
 NAMED_LOGCST (ISOCBINDING_BOOL, "c_bool", \
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 50fda43..1c78a90 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -446,7 +446,7 @@ gfc_init_kinds (void)
       if (!targetm.scalar_mode_supported_p (mode))
 	continue;
 
-      /* Only let float, double, long double and __float128 go through.
+      /* Only let float, double, long double and TFmode go through.
 	 Runtime support for others is not provided, so they would be
 	 useless.  */
       if (!targetm.libgcc_floating_mode_supported_p (mode))
@@ -471,7 +471,14 @@ gfc_init_kinds (void)
 	 We round up so as to handle IA-64 __floatreg (RFmode), which is an
 	 82 bit type.  Not to be confused with __float80 (XFmode), which is
 	 an 80 bit type also supported by IA-64.  So XFmode should come out
-	 to be kind=10, and RFmode should come out to be kind=11.  Egads.  */
+	 to be kind=10, and RFmode should come out to be kind=11.  Egads.
+
+	 TODO: The kind calculation has to be modified to support all
+	 three 128-bit floating-point modes on PowerPC as IFmode, KFmode,
+	 and TFmode since the following line would all map to kind=16.
+	 However, currently only float, double, long double, and TFmode
+	 reach this code.
+      */
 
       kind = (GET_MODE_PRECISION (mode) + 7) / 8;
 
@@ -851,6 +858,7 @@ gfc_build_real_type (gfc_real_info *info)
     info->c_long_double = 1;
   if (mode_precision != LONG_DOUBLE_TYPE_SIZE && mode_precision == 128)
     {
+      /* TODO: see PR101835.  */
       info->c_float128 = 1;
       gfc_real16_is_float128 = true;
     }
-- 
cgit v1.1


From 58f87503427e27bb069bd1841100f3c53440d51a Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 12 Aug 2021 00:16:28 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2e7a9ad..5f9623b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2021-08-11  Sandra Loosemore  <sandra@codesourcery.com>
+
+	* iso-c-binding.def (c_float128, c_float128_complex): Check
+	float128_type_node instead of gfc_float128_type_node.
+	* trans-types.c (gfc_init_kinds, gfc_build_real_type):
+	Update comments re supported 128-bit floating-point types.
+
+2021-08-11  Richard Biener  <rguenther@suse.de>
+
+	* trans-common.c (create_common): Set TREE_THIS_VOLATILE on the
+	COMPONENT_REF if the field is volatile.
+
 2021-08-07  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/68568
-- 
cgit v1.1


From 432de08498142d2266c0fb05f2c555a7f1e10ddd Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Thu, 12 Aug 2021 15:48:28 +0200
Subject: OpenMP 5.1: Add proc-bind 'primary' support

In OpenMP 5.1 "master thread" was changed to "primary thread" and
the proc_bind clause and the OMP_PROC_BIND environment variable
now take 'primary' as argument as alias for 'master', while the
latter is deprecated.
This commit accepts 'primary' and adds the named constant
omp_proc_bind_primary and changes 'master thread' in the
documentation; however, given that not even OpenMP 5.0 is
fully supported, omp_display_env and the dumps currently
still output 'master' and there is no deprecation warning
when using the 'master' in the proc_bind clause.

gcc/c/ChangeLog:

	* c-parser.c (c_parser_omp_clause_proc_bind): Accept
	'primary' as alias for 'master'.

gcc/cp/ChangeLog:

	* parser.c (cp_parser_omp_clause_proc_bind): Accept
	'primary' as alias for 'master'.

gcc/fortran/ChangeLog:

	* gfortran.h (gfc_omp_proc_bind_kind): Add OMP_PROC_BIND_PRIMARY.
	* dump-parse-tree.c (show_omp_clauses): Add TODO comment to
	change 'master' to 'primary' in proc_bind for OpenMP 5.1.
	* intrinsic.texi (OMP_LIB): Mention OpenMP 5.1; add
	omp_proc_bind_primary.
	* openmp.c (gfc_match_omp_clauses): Accept
	'primary' as alias for 'master'.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle
	OMP_PROC_BIND_PRIMARY.

gcc/ChangeLog:

	* tree-core.h (omp_clause_proc_bind_kind): Add
	OMP_CLAUSE_PROC_BIND_PRIMARY.
	* tree-pretty-print.c (dump_omp_clause): Add TODO comment to
	change 'master' to 'primary' in proc_bind for OpenMP 5.1.

libgomp/ChangeLog:

	* env.c (parse_bind_var): Accept 'primary' as alias for
	'master'.
	(omp_display_env): Add TODO comment to
	change 'master' to 'primary' in proc_bind for OpenMP 5.1.
	* libgomp.texi: Change 'master thread' to 'primary thread'
	in line with OpenMP 5.1.
	(omp_get_proc_bind): Add omp_proc_bind_primary and note that
	omp_proc_bind_master is an alias of it.
	(OMP_PROC_BIND): Mention 'PRIMARY'.
	* omp.h.in (__GOMP_DEPRECATED_5_1): Define.
	(omp_proc_bind_primary): Add.
	(omp_proc_bind_master): Deprecate for OpenMP 5.1.
	* omp_lib.f90.in (omp_proc_bind_primary): Add.
	(omp_proc_bind_master): Deprecate for OpenMP 5.1.
	* omp_lib.h.in (omp_proc_bind_primary): Add.
	* testsuite/libgomp.c/affinity-1.c: Check that
	'primary' works and is identical to 'master'.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/pr61486-2.c: Duplicate one proc_bind(master)
	testcase and test proc_bind(primary) instead.
	* gfortran.dg/gomp/affinity-1.f90: Likewise.
---
 gcc/fortran/dump-parse-tree.c | 1 +
 gcc/fortran/gfortran.h        | 1 +
 gcc/fortran/intrinsic.texi    | 6 ++++--
 gcc/fortran/openmp.c          | 5 ++++-
 gcc/fortran/trans-openmp.c    | 3 +++
 5 files changed, 13 insertions(+), 3 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 8e4a101..360abf1 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1712,6 +1712,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       const char *type;
       switch (omp_clauses->proc_bind)
 	{
+	case OMP_PROC_BIND_PRIMARY: type = "PRIMARY"; break;
 	case OMP_PROC_BIND_MASTER: type = "MASTER"; break;
 	case OMP_PROC_BIND_SPREAD: type = "SPREAD"; break;
 	case OMP_PROC_BIND_CLOSE: type = "CLOSE"; break;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 921aed9..8f75dd9 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1362,6 +1362,7 @@ enum gfc_omp_default_sharing
 enum gfc_omp_proc_bind_kind
 {
   OMP_PROC_BIND_UNKNOWN,
+  OMP_PROC_BIND_PRIMARY,
   OMP_PROC_BIND_MASTER,
   OMP_PROC_BIND_SPREAD,
   OMP_PROC_BIND_CLOSE
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 8a92b86..1aacd33 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -15293,8 +15293,9 @@ with the following options: @code{-fno-unsafe-math-optimizations
 @section OpenMP Modules @code{OMP_LIB} and @code{OMP_LIB_KINDS}
 @table @asis
 @item @emph{Standard}:
-OpenMP Application Program Interface v4.5 and
-OpenMP Application Program Interface v5.0 (partially supported).
+OpenMP Application Program Interface v4.5,
+OpenMP Application Program Interface v5.0 (partially supported) and
+OpenMP Application Program Interface v5.1 (partially supported).
 @end table
 
 The OpenMP Fortran runtime library routines are provided both in
@@ -15357,6 +15358,7 @@ kind @code{omp_proc_bind_kind}:
 @table @asis
 @item @code{omp_proc_bind_false}
 @item @code{omp_proc_bind_true}
+@item @code{omp_proc_bind_primary}
 @item @code{omp_proc_bind_master}
 @item @code{omp_proc_bind_close}
 @item @code{omp_proc_bind_spread}
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 520a435..ec55865 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2231,7 +2231,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_PROC_BIND)
 	      && c->proc_bind == OMP_PROC_BIND_UNKNOWN)
 	    {
-	      if (gfc_match ("proc_bind ( master )") == MATCH_YES)
+	      /* Primary is new and master is deprecated in OpenMP 5.1.  */
+	      if (gfc_match ("proc_bind ( primary )") == MATCH_YES)
+		c->proc_bind = OMP_PROC_BIND_MASTER;
+	      else if (gfc_match ("proc_bind ( master )") == MATCH_YES)
 		c->proc_bind = OMP_PROC_BIND_MASTER;
 	      else if (gfc_match ("proc_bind ( spread )") == MATCH_YES)
 		c->proc_bind = OMP_PROC_BIND_SPREAD;
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index ac3f5f3..3d3b35e 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3865,6 +3865,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_PROC_BIND);
       switch (clauses->proc_bind)
 	{
+	case OMP_PROC_BIND_PRIMARY:
+	  OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_PRIMARY;
+	  break;
 	case OMP_PROC_BIND_MASTER:
 	  OMP_CLAUSE_PROC_BIND_KIND (c) = OMP_CLAUSE_PROC_BIND_MASTER;
 	  break;
-- 
cgit v1.1


From 72be20e20299ec57b4bc9ba03d5b7d6bf10e97cc Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 13 Aug 2021 00:16:43 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5f9623b..7e1db26 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2021-08-12  Tobias Burnus  <tobias@codesourcery.com>
+
+	* gfortran.h (gfc_omp_proc_bind_kind): Add OMP_PROC_BIND_PRIMARY.
+	* dump-parse-tree.c (show_omp_clauses): Add TODO comment to
+	change 'master' to 'primary' in proc_bind for OpenMP 5.1.
+	* intrinsic.texi (OMP_LIB): Mention OpenMP 5.1; add
+	omp_proc_bind_primary.
+	* openmp.c (gfc_match_omp_clauses): Accept
+	'primary' as alias for 'master'.
+	* trans-openmp.c (gfc_trans_omp_clauses): Handle
+	OMP_PROC_BIND_PRIMARY.
+
 2021-08-11  Sandra Loosemore  <sandra@codesourcery.com>
 
 	* iso-c-binding.def (c_float128, c_float128_complex): Check
-- 
cgit v1.1


From bbf19f9c20515da9fcd23f08c8139427374e8d77 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sun, 15 Aug 2021 20:13:11 +0200
Subject: Fortran: fix checks for STAT= and ERRMSG= arguments of SYNC ALL/SYNC
 IMAGES

gcc/fortran/ChangeLog:

	PR fortran/99351
	* match.c (sync_statement): Replace %v code by %e in gfc_match to
	allow for function references as STAT and ERRMSG arguments.
	* resolve.c (resolve_sync): Adjust checks of STAT= and ERRMSG= to
	being definable arguments.  Function references with a data
	pointer result are accepted.
	* trans-stmt.c (gfc_trans_sync): Adjust assertion.

gcc/testsuite/ChangeLog:

	PR fortran/99351
	* gfortran.dg/coarray_sync.f90: New test.
	* gfortran.dg/coarray_3.f90: Adjust error messages.
---
 gcc/fortran/match.c      |  4 ++--
 gcc/fortran/resolve.c    | 28 ++++++++++++++++++----------
 gcc/fortran/trans-stmt.c |  6 ++++--
 3 files changed, 24 insertions(+), 14 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index b110548..16502da 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -3855,7 +3855,7 @@ sync_statement (gfc_statement st)
 
   for (;;)
     {
-      m = gfc_match (" stat = %v", &tmp);
+      m = gfc_match (" stat = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto syntax;
       if (m == MATCH_YES)
@@ -3875,7 +3875,7 @@ sync_statement (gfc_statement st)
 	  break;
 	}
 
-      m = gfc_match (" errmsg = %v", &tmp);
+      m = gfc_match (" errmsg = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto syntax;
       if (m == MATCH_YES)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5923646..959f0be 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10236,19 +10236,27 @@ resolve_sync (gfc_code *code)
 
   /* Check STAT.  */
   gfc_resolve_expr (code->expr2);
-  if (code->expr2
-      && (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0
-	  || code->expr2->expr_type != EXPR_VARIABLE))
-    gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
-	       &code->expr2->where);
+  if (code->expr2)
+    {
+      if (code->expr2->ts.type != BT_INTEGER || code->expr2->rank != 0)
+	gfc_error ("STAT= argument at %L must be a scalar INTEGER variable",
+		   &code->expr2->where);
+      else
+	gfc_check_vardef_context (code->expr2, false, false, false,
+				  _("STAT variable"));
+    }
 
   /* Check ERRMSG.  */
   gfc_resolve_expr (code->expr3);
-  if (code->expr3
-      && (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0
-	  || code->expr3->expr_type != EXPR_VARIABLE))
-    gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
-	       &code->expr3->where);
+  if (code->expr3)
+    {
+      if (code->expr3->ts.type != BT_CHARACTER || code->expr3->rank != 0)
+	gfc_error ("ERRMSG= argument at %L must be a scalar CHARACTER variable",
+		   &code->expr3->where);
+      else
+	gfc_check_vardef_context (code->expr3, false, false, false,
+				  _("ERRMSG variable"));
+    }
 }
 
 
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 7cbdef7..11df186 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1226,7 +1226,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
 
   if (code->expr2)
     {
-      gcc_assert (code->expr2->expr_type == EXPR_VARIABLE);
+      gcc_assert (code->expr2->expr_type == EXPR_VARIABLE
+		  || code->expr2->expr_type == EXPR_FUNCTION);
       gfc_init_se (&argse, NULL);
       gfc_conv_expr_val (&argse, code->expr2);
       stat = argse.expr;
@@ -1236,7 +1237,8 @@ gfc_trans_sync (gfc_code *code, gfc_exec_op type)
 
   if (code->expr3 && flag_coarray == GFC_FCOARRAY_LIB)
     {
-      gcc_assert (code->expr3->expr_type == EXPR_VARIABLE);
+      gcc_assert (code->expr3->expr_type == EXPR_VARIABLE
+		  || code->expr3->expr_type == EXPR_FUNCTION);
       gfc_init_se (&argse, NULL);
       argse.want_pointer = 1;
       gfc_conv_expr (&argse, code->expr3);
-- 
cgit v1.1


From 94974e8b580919ded10c3e73348d7af68e74736a Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Mon, 16 Aug 2021 00:16:32 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 10 ++++++++++
 1 file changed, 10 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7e1db26..f4016f6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2021-08-15  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/99351
+	* match.c (sync_statement): Replace %v code by %e in gfc_match to
+	allow for function references as STAT and ERRMSG arguments.
+	* resolve.c (resolve_sync): Adjust checks of STAT= and ERRMSG= to
+	being definable arguments.  Function references with a data
+	pointer result are accepted.
+	* trans-stmt.c (gfc_trans_sync): Adjust assertion.
+
 2021-08-12  Tobias Burnus  <tobias@codesourcery.com>
 
 	* gfortran.h (gfc_omp_proc_bind_kind): Add OMP_PROC_BIND_PRIMARY.
-- 
cgit v1.1


From 53d5b59cb3b417ab8293702aacc75a9bbb3ead78 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 16 Aug 2021 09:26:26 +0200
Subject: Fortran/OpenMP: Add support for OpenMP 5.1 masked construct

Commit r12-2891-gd0befed793b94f3f407be44e6f69f81a02f5f073 added C/C++
support for the masked construct. This patch extends it to
Fortran.

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause.
	(show_omp_node, show_code_node): Handle (combined) omp masked construct.
	* frontend-passes.c (gfc_code_walker): Likewise.
	* gfortran.h (enum gfc_statement): Add ST_OMP_*_MASKED*.
	(enum gfc_exec_op): Add EXEC_OMP_*_MASKED*.
	* match.h (gfc_match_omp_masked, gfc_match_omp_masked_taskloop,
	gfc_match_omp_masked_taskloop_simd, gfc_match_omp_parallel_masked,
	gfc_match_omp_parallel_masked_taskloop,
	gfc_match_omp_parallel_masked_taskloop_simd): New prototypes.
	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_FILTER.
	(gfc_match_omp_clauses): Match it.
	(OMP_MASKED_CLAUSES, gfc_match_omp_parallel_masked,
	gfc_match_omp_parallel_masked_taskloop,
	gfc_match_omp_parallel_masked_taskloop_simd,
	gfc_match_omp_masked, gfc_match_omp_masked_taskloop,
	gfc_match_omp_masked_taskloop_simd): New.
	(resolve_omp_clauses): Resolve filter clause.
	(gfc_resolve_omp_parallel_blocks, resolve_omp_do,
	omp_code_to_statement, gfc_resolve_omp_directive): Handle
	omp masked constructs.
	* parse.c (decode_omp_directive, case_exec_markers,
	gfc_ascii_statement, parse_omp_do, parse_omp_structured_block,
	parse_executable): Likewise.
	* resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise.
	* st.c (gfc_free_statement): Likewise.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle filter clause.
	(GFC_OMP_SPLIT_MASKED, GFC_OMP_MASK_MASKED): New enum values.
	(gfc_trans_omp_masked): New.
	(gfc_split_omp_clauses): Handle combined masked directives.
	(gfc_trans_omp_master_taskloop): Rename to ...
	(gfc_trans_omp_master_masked_taskloop): ... this; handle also
	combined masked directives.
	(gfc_trans_omp_parallel_master): Rename to ...
	(gfc_trans_omp_parallel_master_masked): ... this; handle
	combined masked directives.
	(gfc_trans_omp_directive): Handle EXEC_OMP_*_MASKED*.
	* trans.c (trans_code): Likewise.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/masked-1.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/masked-1.f90: New test.
	* gfortran.dg/gomp/masked-2.f90: New test.
	* gfortran.dg/gomp/masked-3.f90: New test.
	* gfortran.dg/gomp/masked-combined-1.f90: New test.
	* gfortran.dg/gomp/masked-combined-2.f90: New test.
---
 gcc/fortran/dump-parse-tree.c |  24 ++++++
 gcc/fortran/frontend-passes.c |   3 +
 gcc/fortran/gfortran.h        |  14 +++-
 gcc/fortran/match.h           |   6 ++
 gcc/fortran/openmp.c          |  98 +++++++++++++++++++++++
 gcc/fortran/parse.c           |  91 +++++++++++++++++++++-
 gcc/fortran/resolve.c         |  15 ++++
 gcc/fortran/st.c              |   6 ++
 gcc/fortran/trans-openmp.c    | 176 +++++++++++++++++++++++++++++++++++-------
 gcc/fortran/trans.c           |   6 ++
 10 files changed, 406 insertions(+), 33 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 360abf1..53c49fe 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1808,6 +1808,12 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       show_expr (omp_clauses->grainsize);
       fputc (')', dumpfile);
     }
+  if (omp_clauses->filter)
+    {
+      fputs (" FILTER(", dumpfile);
+      show_expr (omp_clauses->filter);
+      fputc (')', dumpfile);
+    }
   if (omp_clauses->hint)
     {
       fputs (" HINT(", dumpfile);
@@ -1946,6 +1952,9 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
     case EXEC_OMP_LOOP: name = "LOOP"; break;
     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
+    case EXEC_OMP_MASKED: name = "MASKED"; break;
+    case EXEC_OMP_MASKED_TASKLOOP: name = "MASKED TASKLOOP"; break;
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD: name = "MASKED TASKLOOP SIMD"; break;
     case EXEC_OMP_MASTER: name = "MASTER"; break;
     case EXEC_OMP_MASTER_TASKLOOP: name = "MASTER TASKLOOP"; break;
     case EXEC_OMP_MASTER_TASKLOOP_SIMD: name = "MASTER TASKLOOP SIMD"; break;
@@ -1956,6 +1965,11 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL_DO_SIMD: name = "PARALLEL DO SIMD"; break;
     case EXEC_OMP_PARALLEL_LOOP: name = "PARALLEL LOOP"; break;
     case EXEC_OMP_PARALLEL_MASTER: name = "PARALLEL MASTER"; break;
+    case EXEC_OMP_PARALLEL_MASKED: name = "PARALLEL MASK"; break;
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+      name = "PARALLEL MASK TASKLOOP"; break;
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+      name = "PARALLEL MASK TASKLOOP SIMD"; break;
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
       name = "PARALLEL MASTER TASKLOOP"; break;
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -2032,10 +2046,14 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_LOOP:
     case EXEC_OMP_ORDERED:
+    case EXEC_OMP_MASKED:
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_LOOP:
+    case EXEC_OMP_PARALLEL_MASKED:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -3250,6 +3268,9 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_FLUSH:
     case EXEC_OMP_LOOP:
+    case EXEC_OMP_MASKED:
+    case EXEC_OMP_MASKED_TASKLOOP:
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_MASTER:
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
@@ -3258,6 +3279,9 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_LOOP:
+    case EXEC_OMP_PARALLEL_MASKED:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 996dcc2..145bff5 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5556,6 +5556,9 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_DO_SIMD:
 	    case EXEC_OMP_PARALLEL_LOOP:
+	    case EXEC_OMP_PARALLEL_MASKED:
+	    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+	    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
 	    case EXEC_OMP_PARALLEL_MASTER:
 	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 8f75dd9..5fde417 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -275,7 +275,13 @@ enum gfc_statement
   ST_OMP_PARALLEL_LOOP, ST_OMP_END_PARALLEL_LOOP, ST_OMP_TEAMS_LOOP,
   ST_OMP_END_TEAMS_LOOP, ST_OMP_TARGET_PARALLEL_LOOP,
   ST_OMP_END_TARGET_PARALLEL_LOOP, ST_OMP_TARGET_TEAMS_LOOP,
-  ST_OMP_END_TARGET_TEAMS_LOOP, ST_NONE
+  ST_OMP_END_TARGET_TEAMS_LOOP, ST_OMP_MASKED, ST_OMP_END_MASKED,
+  ST_OMP_PARALLEL_MASKED, ST_OMP_END_PARALLEL_MASKED,
+  ST_OMP_PARALLEL_MASKED_TASKLOOP, ST_OMP_END_PARALLEL_MASKED_TASKLOOP,
+  ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
+  ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP,
+  ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD,
+  ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -1466,6 +1472,7 @@ typedef struct gfc_omp_clauses
   struct gfc_expr *device;
   struct gfc_expr *thread_limit;
   struct gfc_expr *grainsize;
+  struct gfc_expr *filter;
   struct gfc_expr *hint;
   struct gfc_expr *num_tasks;
   struct gfc_expr *priority;
@@ -2758,7 +2765,10 @@ enum gfc_exec_op
   EXEC_OMP_PARALLEL_MASTER, EXEC_OMP_PARALLEL_MASTER_TASKLOOP,
   EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD, EXEC_OMP_MASTER_TASKLOOP,
   EXEC_OMP_MASTER_TASKLOOP_SIMD, EXEC_OMP_LOOP, EXEC_OMP_PARALLEL_LOOP,
-  EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP, EXEC_OMP_TARGET_TEAMS_LOOP
+  EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP,
+  EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
+  EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
+  EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD
 };
 
 typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index bb1f34f..dce6503 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -169,6 +169,9 @@ match gfc_match_omp_do (void);
 match gfc_match_omp_do_simd (void);
 match gfc_match_omp_loop (void);
 match gfc_match_omp_flush (void);
+match gfc_match_omp_masked (void);
+match gfc_match_omp_masked_taskloop (void);
+match gfc_match_omp_masked_taskloop_simd (void);
 match gfc_match_omp_master (void);
 match gfc_match_omp_master_taskloop (void);
 match gfc_match_omp_master_taskloop_simd (void);
@@ -178,6 +181,9 @@ match gfc_match_omp_parallel (void);
 match gfc_match_omp_parallel_do (void);
 match gfc_match_omp_parallel_do_simd (void);
 match gfc_match_omp_parallel_loop (void);
+match gfc_match_omp_parallel_masked (void);
+match gfc_match_omp_parallel_masked_taskloop (void);
+match gfc_match_omp_parallel_masked_taskloop_simd (void);
 match gfc_match_omp_parallel_master (void);
 match gfc_match_omp_parallel_master_taskloop (void);
 match gfc_match_omp_parallel_master_taskloop_simd (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index ec55865..1bce43c 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -847,6 +847,7 @@ enum omp_mask1
   OMP_CLAUSE_DETACH,  /* OpenMP 5.0.  */
   OMP_CLAUSE_AFFINITY,  /* OpenMP 5.0.  */
   OMP_CLAUSE_BIND,  /* OpenMP 5.0.  */
+  OMP_CLAUSE_FILTER,  /* OpenMP 5.1.  */
   OMP_CLAUSE_NOWAIT,
   /* This must come last.  */
   OMP_MASK1_LAST
@@ -1772,6 +1773,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	    }
 	  break;
 	case 'f':
+	  if ((mask & OMP_CLAUSE_FILTER)
+	      && c->filter == NULL
+	      && gfc_match ("filter ( %e )", &c->filter) == MATCH_YES)
+	    continue;
 	  if ((mask & OMP_CLAUSE_FINAL)
 	      && c->final_expr == NULL
 	      && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
@@ -3199,6 +3204,8 @@ cleanup:
 #define OMP_ATOMIC_CLAUSES \
   (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT	\
    | OMP_CLAUSE_MEMORDER)
+#define OMP_MASKED_CLAUSES \
+  (omp_mask (OMP_CLAUSE_FILTER))
 
 
 static match
@@ -4158,6 +4165,31 @@ gfc_match_omp_parallel_do_simd (void)
 
 
 match
+gfc_match_omp_parallel_masked (void)
+{
+  return match_omp (EXEC_OMP_PARALLEL_MASKED,
+		    OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES);
+}
+
+match
+gfc_match_omp_parallel_masked_taskloop (void)
+{
+  return match_omp (EXEC_OMP_PARALLEL_MASKED_TASKLOOP,
+		    (OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES
+		     | OMP_TASKLOOP_CLAUSES)
+		    & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION)));
+}
+
+match
+gfc_match_omp_parallel_masked_taskloop_simd (void)
+{
+  return match_omp (EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
+		    (OMP_PARALLEL_CLAUSES | OMP_MASKED_CLAUSES
+		     | OMP_TASKLOOP_CLAUSES | OMP_SIMD_CLAUSES)
+		    & ~(omp_mask (OMP_CLAUSE_IN_REDUCTION)));
+}
+
+match
 gfc_match_omp_parallel_master (void)
 {
   return match_omp (EXEC_OMP_PARALLEL_MASTER, OMP_PARALLEL_CLAUSES);
@@ -4704,6 +4736,27 @@ gfc_match_omp_workshare (void)
 
 
 match
+gfc_match_omp_masked (void)
+{
+  return match_omp (EXEC_OMP_MASKED, OMP_MASKED_CLAUSES);
+}
+
+match
+gfc_match_omp_masked_taskloop (void)
+{
+  return match_omp (EXEC_OMP_MASKED_TASKLOOP,
+		    OMP_MASKED_CLAUSES | OMP_TASKLOOP_CLAUSES);
+}
+
+match
+gfc_match_omp_masked_taskloop_simd (void)
+{
+  return match_omp (EXEC_OMP_MASKED_TASKLOOP_SIMD,
+		    (OMP_MASKED_CLAUSES | OMP_TASKLOOP_CLAUSES
+		     | OMP_SIMD_CLAUSES));
+}
+
+match
 gfc_match_omp_master (void)
 {
   if (gfc_match_omp_eos () != MATCH_YES)
@@ -5254,6 +5307,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 
 	    case EXEC_OMP_PARALLEL:
 	    case EXEC_OMP_PARALLEL_DO:
+	    case EXEC_OMP_PARALLEL_MASKED:
 	    case EXEC_OMP_PARALLEL_MASTER:
 	    case EXEC_OMP_PARALLEL_SECTIONS:
 	    case EXEC_OMP_PARALLEL_WORKSHARE:
@@ -5268,10 +5322,12 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	      ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_SIMD;
 	      break;
 
+	    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
 	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	      ok = ifc == OMP_IF_PARALLEL || ifc == OMP_IF_TASKLOOP;
 	      break;
 
+	    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
 	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
 	      ok = (ifc == OMP_IF_PARALLEL
 		    || ifc == OMP_IF_TASKLOOP
@@ -5290,11 +5346,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	      break;
 
 	    case EXEC_OMP_TASKLOOP:
+	    case EXEC_OMP_MASKED_TASKLOOP:
 	    case EXEC_OMP_MASTER_TASKLOOP:
 	      ok = ifc == OMP_IF_TASKLOOP;
 	      break;
 
 	    case EXEC_OMP_TASKLOOP_SIMD:
+	    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
 	    case EXEC_OMP_MASTER_TASKLOOP_SIMD:
 	      ok = ifc == OMP_IF_TASKLOOP || ifc == OMP_IF_SIMD;
 	      break;
@@ -6060,9 +6118,13 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 			&& (code->op == EXEC_OMP_LOOP
 			    || code->op == EXEC_OMP_TASKLOOP
 			    || code->op == EXEC_OMP_TASKLOOP_SIMD
+			    || code->op == EXEC_OMP_MASKED_TASKLOOP
+			    || code->op == EXEC_OMP_MASKED_TASKLOOP_SIMD
 			    || code->op == EXEC_OMP_MASTER_TASKLOOP
 			    || code->op == EXEC_OMP_MASTER_TASKLOOP_SIMD
 			    || code->op == EXEC_OMP_PARALLEL_LOOP
+			    || code->op == EXEC_OMP_PARALLEL_MASKED_TASKLOOP
+			    || code->op == EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD
 			    || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP
 			    || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD
 			    || code->op == EXEC_OMP_TARGET_PARALLEL_LOOP
@@ -6322,6 +6384,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
     resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS");
   if (omp_clauses->device)
     resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE");
+  if (omp_clauses->filter)
+    resolve_nonnegative_int_expr (omp_clauses->filter, "FILTER");
   if (omp_clauses->hint)
     {
       resolve_scalar_int_expr (omp_clauses->hint, "HINT");
@@ -6984,8 +7048,12 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_MASKED_TASKLOOP:
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_TARGET_PARALLEL_DO:
@@ -7133,6 +7201,13 @@ resolve_omp_do (gfc_code *code)
       is_simd = true;
       break;
     case EXEC_OMP_PARALLEL_LOOP: name = "!$OMP PARALLEL LOOP"; break;
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+      name = "!$OMP PARALLEL MASKED TASKLOOP";
+      break;
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+      name = "!$OMP PARALLEL MASKED TASKLOOP SIMD";
+      is_simd = true;
+      break;
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
       name = "!$OMP PARALLEL MASTER TASKLOOP";
       break;
@@ -7140,6 +7215,11 @@ resolve_omp_do (gfc_code *code)
       name = "!$OMP PARALLEL MASTER TASKLOOP SIMD";
       is_simd = true;
       break;
+    case EXEC_OMP_MASKED_TASKLOOP: name = "!$OMP MASKED TASKLOOP"; break;
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+      name = "!$OMP MASKED TASKLOOP SIMD";
+      is_simd = true;
+      break;
     case EXEC_OMP_MASTER_TASKLOOP: name = "!$OMP MASTER TASKLOOP"; break;
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
       name = "!$OMP MASTER TASKLOOP SIMD";
@@ -7302,6 +7382,12 @@ omp_code_to_statement (gfc_code *code)
     {
     case EXEC_OMP_PARALLEL:
       return ST_OMP_PARALLEL;
+    case EXEC_OMP_PARALLEL_MASKED:
+      return ST_OMP_PARALLEL_MASKED;
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+      return ST_OMP_PARALLEL_MASKED_TASKLOOP;
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+      return ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD;
     case EXEC_OMP_PARALLEL_MASTER:
       return ST_OMP_PARALLEL_MASTER;
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
@@ -7316,6 +7402,12 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_ORDERED;
     case EXEC_OMP_CRITICAL:
       return ST_OMP_CRITICAL;
+    case EXEC_OMP_MASKED:
+      return ST_OMP_MASKED;
+    case EXEC_OMP_MASKED_TASKLOOP:
+      return ST_OMP_MASKED_TASKLOOP;
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+      return ST_OMP_MASKED_TASKLOOP_SIMD;
     case EXEC_OMP_MASTER:
       return ST_OMP_MASTER;
     case EXEC_OMP_MASTER_TASKLOOP:
@@ -7822,8 +7914,12 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_LOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_MASKED_TASKLOOP:
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_SIMD:
@@ -7846,8 +7942,10 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
       resolve_omp_do (code);
       break;
     case EXEC_OMP_CANCEL:
+    case EXEC_OMP_MASKED:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_PARALLEL:
+    case EXEC_OMP_PARALLEL_MASKED:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_SECTIONS:
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 6d7845e..e1d78de 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -920,6 +920,11 @@ decode_omp_directive (void)
       matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD);
       matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO);
       matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD);
+      matcho ("end masked taskloop simd", gfc_match_omp_eos_error,
+	      ST_OMP_END_MASKED_TASKLOOP_SIMD);
+      matcho ("end masked taskloop", gfc_match_omp_eos_error,
+	      ST_OMP_END_MASKED_TASKLOOP);
+      matcho ("end masked", gfc_match_omp_eos_error, ST_OMP_END_MASKED);
       matcho ("end master taskloop simd", gfc_match_omp_eos_error,
 	      ST_OMP_END_MASTER_TASKLOOP_SIMD);
       matcho ("end master taskloop", gfc_match_omp_eos_error,
@@ -929,6 +934,12 @@ decode_omp_directive (void)
       matchs ("end parallel do simd", gfc_match_omp_eos_error,
 	      ST_OMP_END_PARALLEL_DO_SIMD);
       matcho ("end parallel do", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO);
+      matcho ("end parallel masked taskloop simd", gfc_match_omp_eos_error,
+	      ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD);
+      matcho ("end parallel masked taskloop", gfc_match_omp_eos_error,
+	      ST_OMP_END_PARALLEL_MASKED_TASKLOOP);
+      matcho ("end parallel masked", gfc_match_omp_eos_error,
+	      ST_OMP_END_PARALLEL_MASKED);
       matcho ("end parallel master taskloop simd", gfc_match_omp_eos_error,
 	      ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD);
       matcho ("end parallel master taskloop", gfc_match_omp_eos_error,
@@ -982,6 +993,11 @@ decode_omp_directive (void)
       matcho ("flush", gfc_match_omp_flush, ST_OMP_FLUSH);
       break;
     case 'm':
+      matcho ("masked taskloop simd", gfc_match_omp_masked_taskloop_simd,
+	      ST_OMP_MASKED_TASKLOOP_SIMD);
+      matcho ("masked taskloop", gfc_match_omp_masked_taskloop,
+	      ST_OMP_MASKED_TASKLOOP);
+      matcho ("masked", gfc_match_omp_masked, ST_OMP_MASKED);
       matcho ("master taskloop simd", gfc_match_omp_master_taskloop_simd,
 	      ST_OMP_MASTER_TASKLOOP_SIMD);
       matcho ("master taskloop", gfc_match_omp_master_taskloop,
@@ -1009,6 +1025,14 @@ decode_omp_directive (void)
       matcho ("parallel do", gfc_match_omp_parallel_do, ST_OMP_PARALLEL_DO);
       matcho ("parallel loop", gfc_match_omp_parallel_loop,
 	      ST_OMP_PARALLEL_LOOP);
+      matcho ("parallel masked taskloop simd",
+	      gfc_match_omp_parallel_masked_taskloop_simd,
+	      ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD);
+      matcho ("parallel masked taskloop",
+	      gfc_match_omp_parallel_masked_taskloop,
+	      ST_OMP_PARALLEL_MASKED_TASKLOOP);
+      matcho ("parallel masked", gfc_match_omp_parallel_masked,
+	      ST_OMP_PARALLEL_MASKED);
       matcho ("parallel master taskloop simd",
 	      gfc_match_omp_parallel_master_taskloop_simd,
 	      ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD);
@@ -1639,11 +1663,15 @@ next_statement (void)
 #define case_exec_markers case ST_DO: case ST_FORALL_BLOCK: \
   case ST_IF_BLOCK: case ST_BLOCK: case ST_ASSOCIATE: \
   case ST_WHERE_BLOCK: case ST_SELECT_CASE: case ST_SELECT_TYPE: \
-  case ST_SELECT_RANK: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASTER: \
+  case ST_SELECT_RANK: case ST_OMP_PARALLEL: case ST_OMP_PARALLEL_MASKED: \
+  case ST_OMP_PARALLEL_MASKED_TASKLOOP: \
+  case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD: case ST_OMP_PARALLEL_MASTER: \
   case ST_OMP_PARALLEL_MASTER_TASKLOOP: \
   case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD: \
   case ST_OMP_PARALLEL_SECTIONS: case ST_OMP_SECTIONS: case ST_OMP_ORDERED: \
-  case ST_OMP_CRITICAL: case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \
+  case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP: \
+  case ST_OMP_MASKED_TASKLOOP_SIMD: \
+  case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \
   case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SINGLE: \
   case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
   case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
@@ -2376,6 +2404,15 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_LOOP:
       p = "!$OMP END LOOP";
       break;
+    case ST_OMP_END_MASKED:
+      p = "!$OMP END MASKED";
+      break;
+    case ST_OMP_END_MASKED_TASKLOOP:
+      p = "!$OMP END MASKED TASKLOOP";
+      break;
+    case ST_OMP_END_MASKED_TASKLOOP_SIMD:
+      p = "!$OMP END MASKED TASKLOOP SIMD";
+      break;
     case ST_OMP_END_MASTER:
       p = "!$OMP END MASTER";
       break;
@@ -2400,6 +2437,15 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_PARALLEL_LOOP:
       p = "!$OMP END PARALLEL LOOP";
       break;
+    case ST_OMP_END_PARALLEL_MASKED:
+      p = "!$OMP END PARALLEL MASKED";
+      break;
+    case ST_OMP_END_PARALLEL_MASKED_TASKLOOP:
+      p = "!$OMP END PARALLEL MASKED TASKLOOP";
+      break;
+    case ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD:
+      p = "!$OMP END PARALLEL MASKED TASKLOOP SIMD";
+      break;
     case ST_OMP_END_PARALLEL_MASTER:
       p = "!$OMP END PARALLEL MASTER";
       break;
@@ -2499,6 +2545,15 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_LOOP:
       p = "!$OMP LOOP";
       break;
+    case ST_OMP_MASKED:
+      p = "!$OMP MASKED";
+      break;
+    case ST_OMP_MASKED_TASKLOOP:
+      p = "!$OMP MASKED TASKLOOP";
+      break;
+    case ST_OMP_MASKED_TASKLOOP_SIMD:
+      p = "!$OMP MASKED TASKLOOP SIMD";
+      break;
     case ST_OMP_MASTER:
       p = "!$OMP MASTER";
       break;
@@ -2524,6 +2579,15 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_PARALLEL_DO_SIMD:
       p = "!$OMP PARALLEL DO SIMD";
       break;
+    case ST_OMP_PARALLEL_MASKED:
+      p = "!$OMP PARALLEL MASKED";
+      break;
+    case ST_OMP_PARALLEL_MASKED_TASKLOOP:
+      p = "!$OMP PARALLEL MASKED TASKLOOP";
+      break;
+    case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+      p = "!$OMP PARALLEL MASKED TASKLOOP SIMD";
+      break;
     case ST_OMP_PARALLEL_MASTER:
       p = "!$OMP PARALLEL MASTER";
       break;
@@ -5127,10 +5191,20 @@ parse_omp_do (gfc_statement omp_st)
       break;
     case ST_OMP_TASKLOOP: omp_end_st = ST_OMP_END_TASKLOOP; break;
     case ST_OMP_TASKLOOP_SIMD: omp_end_st = ST_OMP_END_TASKLOOP_SIMD; break;
+    case ST_OMP_MASKED_TASKLOOP: omp_end_st = ST_OMP_END_MASKED_TASKLOOP; break;
+    case ST_OMP_MASKED_TASKLOOP_SIMD:
+      omp_end_st = ST_OMP_END_MASKED_TASKLOOP_SIMD;
+      break;
     case ST_OMP_MASTER_TASKLOOP: omp_end_st = ST_OMP_END_MASTER_TASKLOOP; break;
     case ST_OMP_MASTER_TASKLOOP_SIMD:
       omp_end_st = ST_OMP_END_MASTER_TASKLOOP_SIMD;
       break;
+    case ST_OMP_PARALLEL_MASKED_TASKLOOP:
+      omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP;
+      break;
+    case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+      omp_end_st = ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD;
+      break;
     case ST_OMP_PARALLEL_MASTER_TASKLOOP:
       omp_end_st = ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
       break;
@@ -5380,6 +5454,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_PARALLEL:
       omp_end_st = ST_OMP_END_PARALLEL;
       break;
+    case ST_OMP_PARALLEL_MASKED:
+      omp_end_st = ST_OMP_END_PARALLEL_MASKED;
+      break;
     case ST_OMP_PARALLEL_MASTER:
       omp_end_st = ST_OMP_END_PARALLEL_MASTER;
       break;
@@ -5395,6 +5472,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_CRITICAL:
       omp_end_st = ST_OMP_END_CRITICAL;
       break;
+    case ST_OMP_MASKED:
+      omp_end_st = ST_OMP_END_MASKED;
+      break;
     case ST_OMP_MASTER:
       omp_end_st = ST_OMP_END_MASTER;
       break;
@@ -5477,6 +5557,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 		  break;
 
 		case ST_OMP_PARALLEL:
+		case ST_OMP_PARALLEL_MASKED:
 		case ST_OMP_PARALLEL_MASTER:
 		case ST_OMP_PARALLEL_SECTIONS:
 		  parse_omp_structured_block (st, false);
@@ -5679,11 +5760,13 @@ parse_executable (gfc_statement st)
 	  break;
 
 	case ST_OMP_PARALLEL:
+	case ST_OMP_PARALLEL_MASKED:
 	case ST_OMP_PARALLEL_MASTER:
 	case ST_OMP_PARALLEL_SECTIONS:
 	case ST_OMP_SECTIONS:
 	case ST_OMP_ORDERED:
 	case ST_OMP_CRITICAL:
+	case ST_OMP_MASKED:
 	case ST_OMP_MASTER:
 	case ST_OMP_SINGLE:
 	case ST_OMP_TARGET:
@@ -5711,8 +5794,12 @@ parse_executable (gfc_statement st)
 	case ST_OMP_PARALLEL_DO:
 	case ST_OMP_PARALLEL_DO_SIMD:
 	case ST_OMP_PARALLEL_LOOP:
+	case ST_OMP_PARALLEL_MASKED_TASKLOOP:
+	case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
 	case ST_OMP_PARALLEL_MASTER_TASKLOOP:
 	case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+	case ST_OMP_MASKED_TASKLOOP:
+	case ST_OMP_MASKED_TASKLOOP_SIMD:
 	case ST_OMP_MASTER_TASKLOOP:
 	case ST_OMP_MASTER_TASKLOOP_SIMD:
 	case ST_OMP_SIMD:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 959f0be..8eb8a9a 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10818,6 +10818,9 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
 	case EXEC_OMP_LOOP:
+	case EXEC_OMP_MASKED:
+	case EXEC_OMP_MASKED_TASKLOOP:
+	case EXEC_OMP_MASKED_TASKLOOP_SIMD:
 	case EXEC_OMP_MASTER:
 	case EXEC_OMP_MASTER_TASKLOOP:
 	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
@@ -10826,6 +10829,9 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
 	case EXEC_OMP_PARALLEL_LOOP:
+	case EXEC_OMP_PARALLEL_MASKED:
+	case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+	case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
 	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -11793,6 +11799,9 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
 	    case EXEC_OMP_PARALLEL:
 	    case EXEC_OMP_PARALLEL_DO:
 	    case EXEC_OMP_PARALLEL_DO_SIMD:
+	    case EXEC_OMP_PARALLEL_MASKED:
+	    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+	    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
 	    case EXEC_OMP_PARALLEL_MASTER:
 	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	    case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
@@ -12248,6 +12257,9 @@ start:
 	case EXEC_OMP_MASTER:
 	case EXEC_OMP_MASTER_TASKLOOP:
 	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+	case EXEC_OMP_MASKED:
+	case EXEC_OMP_MASKED_TASKLOOP:
+	case EXEC_OMP_MASKED_TASKLOOP_SIMD:
 	case EXEC_OMP_ORDERED:
 	case EXEC_OMP_SCAN:
 	case EXEC_OMP_SECTIONS:
@@ -12289,6 +12301,9 @@ start:
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
 	case EXEC_OMP_PARALLEL_LOOP:
+	case EXEC_OMP_PARALLEL_MASKED:
+	case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+	case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
 	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 6ae1df6..f61f88a 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -227,13 +227,19 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_DO_SIMD:
     case EXEC_OMP_LOOP:
     case EXEC_OMP_END_SINGLE:
+    case EXEC_OMP_MASKED_TASKLOOP:
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_ORDERED:
+    case EXEC_OMP_MASKED:
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
     case EXEC_OMP_PARALLEL_DO_SIMD:
     case EXEC_OMP_PARALLEL_LOOP:
+    case EXEC_OMP_PARALLEL_MASKED:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 3d3b35e..623c21f 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4047,6 +4047,21 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
+  if (clauses->filter)
+    {
+      tree filter;
+
+      gfc_init_se (&se, NULL);
+      gfc_conv_expr (&se, clauses->filter);
+      gfc_add_block_to_block (block, &se.pre);
+      filter = gfc_evaluate_now (se.expr, block);
+      gfc_add_block_to_block (block, &se.post);
+
+      c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_FILTER);
+      OMP_CLAUSE_FILTER_EXPR (c) = filter;
+      omp_clauses = gfc_trans_add_clause (c, omp_clauses);
+    }
+
   if (clauses->hint)
     {
       tree hint;
@@ -5390,6 +5405,26 @@ gfc_trans_omp_master (gfc_code *code)
 }
 
 static tree
+gfc_trans_omp_masked (gfc_code *code, gfc_omp_clauses *clauses)
+{
+  stmtblock_t block;
+  tree body = gfc_trans_code (code->block->next);
+  if (IS_EMPTY_STMT (body))
+    return body;
+  if (!clauses)
+    clauses = code->ext.omp_clauses;
+  gfc_start_block (&block);
+  tree omp_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc);
+  tree stmt = make_node (OMP_MASKED);
+  TREE_TYPE (stmt) = void_type_node;
+  OMP_MASKED_BODY (stmt) = body;
+  OMP_MASKED_CLAUSES (stmt) = omp_clauses;
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+
+static tree
 gfc_trans_omp_ordered (gfc_code *code)
 {
   if (!flag_openmp)
@@ -5432,6 +5467,7 @@ enum
   GFC_OMP_SPLIT_TEAMS,
   GFC_OMP_SPLIT_TARGET,
   GFC_OMP_SPLIT_TASKLOOP,
+  GFC_OMP_SPLIT_MASKED,
   GFC_OMP_SPLIT_NUM
 };
 
@@ -5443,7 +5479,8 @@ enum
   GFC_OMP_MASK_DISTRIBUTE = (1 << GFC_OMP_SPLIT_DISTRIBUTE),
   GFC_OMP_MASK_TEAMS = (1 << GFC_OMP_SPLIT_TEAMS),
   GFC_OMP_MASK_TARGET = (1 << GFC_OMP_SPLIT_TARGET),
-  GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP)
+  GFC_OMP_MASK_TASKLOOP = (1 << GFC_OMP_SPLIT_TASKLOOP),
+  GFC_OMP_MASK_MASKED = (1 << GFC_OMP_SPLIT_MASKED)
 };
 
 /* If a var is in lastprivate/firstprivate/reduction but not in a
@@ -5632,10 +5669,24 @@ gfc_split_omp_clauses (gfc_code *code,
       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_SIMD;
       break;
+    case EXEC_OMP_PARALLEL_MASKED:
+      mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED;
+      innermost = GFC_OMP_SPLIT_MASKED;
+      break;
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+      mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED
+	      | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD);
+      innermost = GFC_OMP_SPLIT_TASKLOOP;
+      break;
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_TASKLOOP;
       break;
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+      mask = (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_MASKED
+	      | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD);
+      innermost = GFC_OMP_SPLIT_SIMD;
+      break;
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
       mask = GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
       innermost = GFC_OMP_SPLIT_SIMD;
@@ -5692,10 +5743,18 @@ gfc_split_omp_clauses (gfc_code *code,
       mask = GFC_OMP_MASK_TARGET | GFC_OMP_MASK_TEAMS | GFC_OMP_MASK_DO;
       innermost = GFC_OMP_SPLIT_DO;
       break;
+    case EXEC_OMP_MASKED_TASKLOOP:
+      mask = GFC_OMP_SPLIT_MASKED | GFC_OMP_SPLIT_TASKLOOP;
+      innermost = GFC_OMP_SPLIT_TASKLOOP;
+      break;
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_TASKLOOP:
       innermost = GFC_OMP_SPLIT_TASKLOOP;
       break;
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+      mask = GFC_OMP_MASK_MASKED | GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
+      innermost = GFC_OMP_SPLIT_SIMD;
+      break;
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
     case EXEC_OMP_TASKLOOP_SIMD:
       mask = GFC_OMP_MASK_TASKLOOP | GFC_OMP_MASK_SIMD;
@@ -5814,6 +5873,8 @@ gfc_split_omp_clauses (gfc_code *code,
 	  clausesa[GFC_OMP_SPLIT_PARALLEL].if_expr
 	    = code->ext.omp_clauses->if_expr;
 	}
+      if (mask & GFC_OMP_MASK_MASKED)
+	clausesa[GFC_OMP_SPLIT_MASKED].filter = code->ext.omp_clauses->filter;
       if ((mask & GFC_OMP_MASK_DO) && !is_loop)
 	{
 	  /* First the clauses that are unique to some constructs.  */
@@ -5896,16 +5957,18 @@ gfc_split_omp_clauses (gfc_code *code,
 	  clausesa[GFC_OMP_SPLIT_TASKLOOP].collapse
 	    = code->ext.omp_clauses->collapse;
 	}
-      /* Private clause is supported on all constructs,
-	 it is enough to put it on the innermost one.  For
+      /* Private clause is supported on all constructs but master/masked,
+	 it is enough to put it on the innermost one except for master/masked.  For
 	 !$ omp parallel do put it on parallel though,
 	 as that's what we did for OpenMP 3.1.  */
-      clausesa[innermost == GFC_OMP_SPLIT_DO && !is_loop
+      clausesa[((innermost == GFC_OMP_SPLIT_DO && !is_loop)
+		|| code->op == EXEC_OMP_PARALLEL_MASTER
+		|| code->op == EXEC_OMP_PARALLEL_MASKED)
 	       ? (int) GFC_OMP_SPLIT_PARALLEL
 	       : innermost].lists[OMP_LIST_PRIVATE]
 	= code->ext.omp_clauses->lists[OMP_LIST_PRIVATE];
       /* Firstprivate clause is supported on all constructs but
-	 simd.  Put it on the outermost of those and duplicate
+	 simd and masked/master.  Put it on the outermost of those and duplicate
 	 on parallel and teams.  */
       if (mask & GFC_OMP_MASK_TARGET)
 	clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_FIRSTPRIVATE]
@@ -6588,43 +6651,66 @@ gfc_trans_omp_taskloop (gfc_code *code, gfc_exec_op op)
 }
 
 static tree
-gfc_trans_omp_master_taskloop (gfc_code *code, gfc_exec_op op)
+gfc_trans_omp_master_masked_taskloop (gfc_code *code, gfc_exec_op op)
 {
+  gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
   stmtblock_t block;
   tree stmt;
 
-  gfc_start_block (&block);
+  if (op != EXEC_OMP_MASTER_TASKLOOP_SIMD
+      && code->op != EXEC_OMP_MASTER_TASKLOOP)
+    gfc_split_omp_clauses (code, clausesa);
+
   pushlevel ();
-  if (op == EXEC_OMP_MASTER_TASKLOOP_SIMD)
+  if (op == EXEC_OMP_MASKED_TASKLOOP_SIMD
+      || op == EXEC_OMP_MASTER_TASKLOOP_SIMD)
     stmt = gfc_trans_omp_taskloop (code, EXEC_OMP_TASKLOOP_SIMD);
   else
     {
-      gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
-      gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP);
-      if (op != code->op)
-	gfc_split_omp_clauses (code, clausesa);
+      gcc_assert (op == EXEC_OMP_MASKED_TASKLOOP
+		  || op == EXEC_OMP_MASTER_TASKLOOP);
       stmt = gfc_trans_omp_do (code, EXEC_OMP_TASKLOOP, NULL,
-			       op != code->op
+			       code->op != EXEC_OMP_MASTER_TASKLOOP
 			       ? &clausesa[GFC_OMP_SPLIT_TASKLOOP]
 			       : code->ext.omp_clauses, NULL);
-      if (op != code->op)
-	gfc_free_split_omp_clauses (code, clausesa);
     }
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
   else
     poplevel (0, 0);
-  stmt = build1_v (OMP_MASTER, stmt);
-  gfc_add_expr_to_block (&block, stmt);
+  gfc_start_block (&block);
+  if (op == EXEC_OMP_MASKED_TASKLOOP || op == EXEC_OMP_MASKED_TASKLOOP_SIMD)
+    {
+      tree clauses = gfc_trans_omp_clauses (&block,
+					    &clausesa[GFC_OMP_SPLIT_MASKED],
+					    code->loc);
+      tree msk = make_node (OMP_MASKED);
+      TREE_TYPE (msk) = void_type_node;
+      OMP_MASKED_BODY (msk) = stmt;
+      OMP_MASKED_CLAUSES (msk) = clauses;
+      OMP_MASKED_COMBINED (msk) = 1;
+      gfc_add_expr_to_block (&block, msk);
+    }
+  else
+    {
+      gcc_assert (op == EXEC_OMP_MASTER_TASKLOOP
+		  || op == EXEC_OMP_MASTER_TASKLOOP_SIMD);
+      stmt = build1_v (OMP_MASTER, stmt);
+      gfc_add_expr_to_block (&block, stmt);
+    }
+  if (op != EXEC_OMP_MASTER_TASKLOOP_SIMD
+      && code->op != EXEC_OMP_MASTER_TASKLOOP)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
 static tree
-gfc_trans_omp_parallel_master (gfc_code *code)
+gfc_trans_omp_parallel_master_masked (gfc_code *code)
 {
   stmtblock_t block;
   tree stmt, omp_clauses;
   gfc_omp_clauses clausesa[GFC_OMP_SPLIT_NUM];
+  bool parallel_combined = false;
 
   if (code->op != EXEC_OMP_PARALLEL_MASTER)
     gfc_split_omp_clauses (code, clausesa);
@@ -6635,19 +6721,33 @@ gfc_trans_omp_parallel_master (gfc_code *code)
 				       ? code->ext.omp_clauses
 				       : &clausesa[GFC_OMP_SPLIT_PARALLEL],
 				       code->loc);
-  if (code->op != EXEC_OMP_PARALLEL_MASTER)
-    gfc_free_split_omp_clauses (code, clausesa);
   pushlevel ();
   if (code->op == EXEC_OMP_PARALLEL_MASTER)
     stmt = gfc_trans_omp_master (code);
+  else if (code->op == EXEC_OMP_PARALLEL_MASKED)
+    stmt = gfc_trans_omp_masked (code, &clausesa[GFC_OMP_SPLIT_MASKED]);
   else
     {
-      gcc_assert (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP
-		  || code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD);
-      gfc_exec_op op = (code->op == EXEC_OMP_PARALLEL_MASTER_TASKLOOP
-			? EXEC_OMP_MASTER_TASKLOOP
-			: EXEC_OMP_MASTER_TASKLOOP_SIMD);
-      stmt = gfc_trans_omp_master_taskloop (code, op);
+      gfc_exec_op op;
+      switch (code->op)
+	{
+	case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+	  op = EXEC_OMP_MASKED_TASKLOOP;
+	  break;
+	case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+	  op = EXEC_OMP_MASKED_TASKLOOP_SIMD;
+	  break;
+	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
+	  op = EXEC_OMP_MASTER_TASKLOOP;
+	  break;
+	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+	  op = EXEC_OMP_MASTER_TASKLOOP_SIMD;
+	  break;
+	default:
+	  gcc_unreachable ();
+	}
+      stmt = gfc_trans_omp_master_masked_taskloop (code, op);
+      parallel_combined = true;
     }
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -6655,8 +6755,19 @@ gfc_trans_omp_parallel_master (gfc_code *code)
     poplevel (0, 0);
   stmt = build2_loc (gfc_get_location (&code->loc), OMP_PARALLEL,
 		     void_type_node, stmt, omp_clauses);
-  OMP_PARALLEL_COMBINED (stmt) = 1;
+  /* masked does have just filter clause, but during gimplification
+     isn't represented by a gimplification omp context, so for
+       !$omp parallel masked don't set OMP_PARALLEL_COMBINED,
+     so that
+       !$omp parallel masked
+       !$omp taskloop simd lastprivate (x)
+     isn't confused with
+       !$omp parallel masked taskloop simd lastprivate (x)  */
+  if (parallel_combined)
+    OMP_PARALLEL_COMBINED (stmt) = 1;
   gfc_add_expr_to_block (&block, stmt);
+  if (code->op != EXEC_OMP_PARALLEL_MASTER)
+    gfc_free_split_omp_clauses (code, clausesa);
   return gfc_finish_block (&block);
 }
 
@@ -6969,11 +7080,15 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE);
     case EXEC_OMP_FLUSH:
       return gfc_trans_omp_flush (code);
+    case EXEC_OMP_MASKED:
+      return gfc_trans_omp_masked (code, NULL);
     case EXEC_OMP_MASTER:
       return gfc_trans_omp_master (code);
+    case EXEC_OMP_MASKED_TASKLOOP:
+    case EXEC_OMP_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
-      return gfc_trans_omp_master_taskloop (code, code->op);
+      return gfc_trans_omp_master_masked_taskloop (code, code->op);
     case EXEC_OMP_ORDERED:
       return gfc_trans_omp_ordered (code);
     case EXEC_OMP_PARALLEL:
@@ -6984,10 +7099,13 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_parallel_do (code, true, NULL, NULL);
     case EXEC_OMP_PARALLEL_DO_SIMD:
       return gfc_trans_omp_parallel_do_simd (code, NULL, NULL);
+    case EXEC_OMP_PARALLEL_MASKED:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+    case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
     case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
-      return gfc_trans_omp_parallel_master (code);
+      return gfc_trans_omp_parallel_master_masked (code);
     case EXEC_OMP_PARALLEL_SECTIONS:
       return gfc_trans_omp_parallel_sections (code);
     case EXEC_OMP_PARALLEL_WORKSHARE:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 275d6a2..ce5b2f8 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2156,6 +2156,9 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_DO_SIMD:
 	case EXEC_OMP_LOOP:
 	case EXEC_OMP_FLUSH:
+	case EXEC_OMP_MASKED:
+	case EXEC_OMP_MASKED_TASKLOOP:
+	case EXEC_OMP_MASKED_TASKLOOP_SIMD:
 	case EXEC_OMP_MASTER:
 	case EXEC_OMP_MASTER_TASKLOOP:
 	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
@@ -2164,6 +2167,9 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_PARALLEL_DO:
 	case EXEC_OMP_PARALLEL_DO_SIMD:
 	case EXEC_OMP_PARALLEL_LOOP:
+	case EXEC_OMP_PARALLEL_MASKED:
+	case EXEC_OMP_PARALLEL_MASKED_TASKLOOP:
+	case EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
 	case EXEC_OMP_PARALLEL_MASTER:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP:
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
-- 
cgit v1.1


From 9d1d9fc8b4a1d0aefd13d573d3957ca5720dd519 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 17 Aug 2021 00:16:32 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 40 ++++++++++++++++++++++++++++++++++++++++
 1 file changed, 40 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f4016f6..5b3744c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,43 @@
+2021-08-16  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause.
+	(show_omp_node, show_code_node): Handle (combined) omp masked construct.
+	* frontend-passes.c (gfc_code_walker): Likewise.
+	* gfortran.h (enum gfc_statement): Add ST_OMP_*_MASKED*.
+	(enum gfc_exec_op): Add EXEC_OMP_*_MASKED*.
+	* match.h (gfc_match_omp_masked, gfc_match_omp_masked_taskloop,
+	gfc_match_omp_masked_taskloop_simd, gfc_match_omp_parallel_masked,
+	gfc_match_omp_parallel_masked_taskloop,
+	gfc_match_omp_parallel_masked_taskloop_simd): New prototypes.
+	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_FILTER.
+	(gfc_match_omp_clauses): Match it.
+	(OMP_MASKED_CLAUSES, gfc_match_omp_parallel_masked,
+	gfc_match_omp_parallel_masked_taskloop,
+	gfc_match_omp_parallel_masked_taskloop_simd,
+	gfc_match_omp_masked, gfc_match_omp_masked_taskloop,
+	gfc_match_omp_masked_taskloop_simd): New.
+	(resolve_omp_clauses): Resolve filter clause.
+	(gfc_resolve_omp_parallel_blocks, resolve_omp_do,
+	omp_code_to_statement, gfc_resolve_omp_directive): Handle
+	omp masked constructs.
+	* parse.c (decode_omp_directive, case_exec_markers,
+	gfc_ascii_statement, parse_omp_do, parse_omp_structured_block,
+	parse_executable): Likewise.
+	* resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise.
+	* st.c (gfc_free_statement): Likewise.
+	* trans-openmp.c (gfc_trans_omp_clauses): Handle filter clause.
+	(GFC_OMP_SPLIT_MASKED, GFC_OMP_MASK_MASKED): New enum values.
+	(gfc_trans_omp_masked): New.
+	(gfc_split_omp_clauses): Handle combined masked directives.
+	(gfc_trans_omp_master_taskloop): Rename to ...
+	(gfc_trans_omp_master_masked_taskloop): ... this; handle also
+	combined masked directives.
+	(gfc_trans_omp_parallel_master): Rename to ...
+	(gfc_trans_omp_parallel_master_masked): ... this; handle
+	combined masked directives.
+	(gfc_trans_omp_directive): Handle EXEC_OMP_*_MASKED*.
+	* trans.c (trans_code): Likewise.
+
 2021-08-15  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/99351
-- 
cgit v1.1


From f8d535f3fec81c1cc84e22df5500e693544ec65b Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 17 Aug 2021 15:50:11 +0200
Subject: Fortran: Implement OpenMP 5.1 scope construct

Fortran version to commit e45483c7c4badc4bf2d6ced22360ce1ab172967f,
which implemented OpenMP's scope construct for C and C++.
Most testcases are based on the C testcases; it also contains some
testcases which existed previously but had no Fortran equivalent.

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
	EXEC_OMP_SCOPE.
	* gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE.
	(enum gfc_exec_op): Add EXEC_OMP_SCOPE.
	* match.h (gfc_match_omp_scope): New.
	* openmp.c (OMP_SCOPE_CLAUSES): Define
	(gfc_match_omp_scope): New.
	(gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait):
	Improve error diagnostic.
	(omp_code_to_statement): Handle ST_OMP_SCOPE.
	(gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE.
	* parse.c (decode_omp_directive, next_statement,
	gfc_ascii_statement, parse_omp_structured_block,
	parse_executable): Handle OpenMP's scope construct.
	* resolve.c (gfc_resolve_blocks): Likewise
	* st.c (gfc_free_statement): Likewise
	* trans-openmp.c (gfc_trans_omp_scope): New.
	(gfc_trans_omp_directive): Call it.
	* trans.c (trans_code): handle EXEC_OMP_SCOPE.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/scope-1.f90: New test.
	* testsuite/libgomp.fortran/task-reduction-16.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/scan-1.f90:
	* gfortran.dg/gomp/cancel-1.f90: New test.
	* gfortran.dg/gomp/cancel-4.f90: New test.
	* gfortran.dg/gomp/loop-4.f90: New test.
	* gfortran.dg/gomp/nesting-1.f90: New test.
	* gfortran.dg/gomp/nesting-2.f90: New test.
	* gfortran.dg/gomp/nesting-3.f90: New test.
	* gfortran.dg/gomp/nowait-1.f90: New test.
	* gfortran.dg/gomp/reduction-task-1.f90: New test.
	* gfortran.dg/gomp/reduction-task-2.f90: New test.
	* gfortran.dg/gomp/reduction-task-2a.f90: New test.
	* gfortran.dg/gomp/reduction-task-3.f90: New test.
	* gfortran.dg/gomp/scope-1.f90: New test.
	* gfortran.dg/gomp/scope-2.f90: New test.
---
 gcc/fortran/dump-parse-tree.c |  3 +++
 gcc/fortran/gfortran.h        |  4 ++--
 gcc/fortran/match.h           |  1 +
 gcc/fortran/openmp.c          | 23 +++++++++++++++++++++--
 gcc/fortran/parse.c           | 13 +++++++++++--
 gcc/fortran/resolve.c         |  2 ++
 gcc/fortran/st.c              |  1 +
 gcc/fortran/trans-openmp.c    | 20 ++++++++++++++++++++
 gcc/fortran/trans.c           |  1 +
 9 files changed, 62 insertions(+), 6 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 53c49fe..92d9f9e 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1977,6 +1977,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL_SECTIONS: name = "PARALLEL SECTIONS"; break;
     case EXEC_OMP_PARALLEL_WORKSHARE: name = "PARALLEL WORKSHARE"; break;
     case EXEC_OMP_SCAN: name = "SCAN"; break;
+    case EXEC_OMP_SCOPE: name = "SCOPE"; break;
     case EXEC_OMP_SECTIONS: name = "SECTIONS"; break;
     case EXEC_OMP_SIMD: name = "SIMD"; break;
     case EXEC_OMP_SINGLE: name = "SINGLE"; break;
@@ -2060,6 +2061,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
+    case EXEC_OMP_SCOPE:
     case EXEC_OMP_SECTIONS:
     case EXEC_OMP_SIMD:
     case EXEC_OMP_SINGLE:
@@ -3288,6 +3290,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
+    case EXEC_OMP_SCOPE:
     case EXEC_OMP_SECTIONS:
     case EXEC_OMP_SIMD:
     case EXEC_OMP_SINGLE:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5fde417..a7d82ae 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -281,7 +281,7 @@ enum gfc_statement
   ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
   ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP,
   ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD,
-  ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_NONE
+  ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -2768,7 +2768,7 @@ enum gfc_exec_op
   EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP,
   EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
   EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
-  EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD
+  EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE
 };
 
 typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index dce6503..aac16a8 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -190,6 +190,7 @@ match gfc_match_omp_parallel_master_taskloop_simd (void);
 match gfc_match_omp_parallel_sections (void);
 match gfc_match_omp_parallel_workshare (void);
 match gfc_match_omp_requires (void);
+match gfc_match_omp_scope (void);
 match gfc_match_omp_scan (void);
 match gfc_match_omp_sections (void);
 match gfc_match_omp_simd (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1bce43c..9675b65 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -3150,6 +3150,8 @@ cleanup:
 #define OMP_LOOP_CLAUSES \
   (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER	\
    | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
+#define OMP_SCOPE_CLAUSES \
+  (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION)
 #define OMP_SECTIONS_CLAUSES \
   (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE		\
    | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
@@ -4488,6 +4490,13 @@ gfc_match_omp_scan (void)
 
 
 match
+gfc_match_omp_scope (void)
+{
+  return match_omp (EXEC_OMP_SCOPE, OMP_SCOPE_CLAUSES);
+}
+
+
+match
 gfc_match_omp_sections (void)
 {
   return match_omp (EXEC_OMP_SECTIONS, OMP_SECTIONS_CLAUSES);
@@ -4975,7 +4984,11 @@ gfc_match_omp_cancellation_point (void)
   gfc_omp_clauses *c;
   enum gfc_omp_cancel_kind kind = gfc_match_omp_cancel_kind ();
   if (kind == OMP_CANCEL_UNKNOWN)
-    return MATCH_ERROR;
+    {
+      gfc_error ("Expected construct-type PARALLEL, SECTIONS, DO or TASKGROUP "
+		 "in $OMP CANCELLATION POINT statement at %C");
+      return MATCH_ERROR;
+    }
   if (gfc_match_omp_eos () != MATCH_YES)
     {
       gfc_error ("Unexpected junk after $OMP CANCELLATION POINT statement "
@@ -4998,7 +5011,10 @@ gfc_match_omp_end_nowait (void)
     nowait = true;
   if (gfc_match_omp_eos () != MATCH_YES)
     {
-      gfc_error ("Unexpected junk after NOWAIT clause at %C");
+      if (nowait)
+	gfc_error ("Unexpected junk after NOWAIT clause at %C");
+      else
+	gfc_error ("Unexpected junk at %C");
       return MATCH_ERROR;
     }
   new_st.op = EXEC_OMP_END_NOWAIT;
@@ -7448,6 +7464,8 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_DO_SIMD;
     case EXEC_OMP_SCAN:
       return ST_OMP_SCAN;
+    case EXEC_OMP_SCOPE:
+      return ST_OMP_SCOPE;
     case EXEC_OMP_SIMD:
       return ST_OMP_SIMD;
     case EXEC_OMP_TARGET:
@@ -7948,6 +7966,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_PARALLEL_MASKED:
     case EXEC_OMP_PARALLEL_MASTER:
     case EXEC_OMP_PARALLEL_SECTIONS:
+    case EXEC_OMP_SCOPE:
     case EXEC_OMP_SECTIONS:
     case EXEC_OMP_SINGLE:
     case EXEC_OMP_TARGET:
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index e1d78de..24cc9bf 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -951,6 +951,7 @@ decode_omp_directive (void)
       matcho ("end parallel workshare", gfc_match_omp_eos_error,
 	      ST_OMP_END_PARALLEL_WORKSHARE);
       matcho ("end parallel", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL);
+      matcho ("end scope", gfc_match_omp_end_nowait, ST_OMP_END_SCOPE);
       matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS);
       matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE);
       matcho ("end target data", gfc_match_omp_eos_error, ST_OMP_END_TARGET_DATA);
@@ -1052,6 +1053,7 @@ decode_omp_directive (void)
       break;
     case 's':
       matcho ("scan", gfc_match_omp_scan, ST_OMP_SCAN);
+      matcho ("scope", gfc_match_omp_scope, ST_OMP_SCOPE);
       matcho ("sections", gfc_match_omp_sections, ST_OMP_SECTIONS);
       matcho ("section", gfc_match_omp_eos_error, ST_OMP_SECTION);
       matcho ("single", gfc_match_omp_single, ST_OMP_SINGLE);
@@ -1672,7 +1674,7 @@ next_statement (void)
   case ST_OMP_CRITICAL: case ST_OMP_MASKED: case ST_OMP_MASKED_TASKLOOP: \
   case ST_OMP_MASKED_TASKLOOP_SIMD: \
   case ST_OMP_MASTER: case ST_OMP_MASTER_TASKLOOP: \
-  case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SINGLE: \
+  case ST_OMP_MASTER_TASKLOOP_SIMD: case ST_OMP_SCOPE: case ST_OMP_SINGLE: \
   case ST_OMP_DO: case ST_OMP_PARALLEL_DO: case ST_OMP_ATOMIC: \
   case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE: \
   case ST_OMP_TASK: case ST_OMP_TASKGROUP: case ST_OMP_SIMD: \
@@ -2609,6 +2611,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_SCAN:
       p = "!$OMP SCAN";
       break;
+    case ST_OMP_SCOPE:
+      p = "!$OMP SCOPE";
+      break;
     case ST_OMP_SECTIONS:
       p = "!$OMP SECTIONS";
       break;
@@ -5463,6 +5468,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
     case ST_OMP_PARALLEL_SECTIONS:
       omp_end_st = ST_OMP_END_PARALLEL_SECTIONS;
       break;
+    case ST_OMP_SCOPE:
+      omp_end_st = ST_OMP_END_SCOPE;
+      break;
     case ST_OMP_SECTIONS:
       omp_end_st = ST_OMP_END_SECTIONS;
       break;
@@ -5763,11 +5771,12 @@ parse_executable (gfc_statement st)
 	case ST_OMP_PARALLEL_MASKED:
 	case ST_OMP_PARALLEL_MASTER:
 	case ST_OMP_PARALLEL_SECTIONS:
-	case ST_OMP_SECTIONS:
 	case ST_OMP_ORDERED:
 	case ST_OMP_CRITICAL:
 	case ST_OMP_MASKED:
 	case ST_OMP_MASTER:
+	case ST_OMP_SCOPE:
+	case ST_OMP_SECTIONS:
 	case ST_OMP_SINGLE:
 	case ST_OMP_TARGET:
 	case ST_OMP_TARGET_DATA:
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8eb8a9a..117062b 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10839,6 +10839,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_PARALLEL_WORKSHARE:
 	case EXEC_OMP_SECTIONS:
 	case EXEC_OMP_SIMD:
+	case EXEC_OMP_SCOPE:
 	case EXEC_OMP_SINGLE:
 	case EXEC_OMP_TARGET:
 	case EXEC_OMP_TARGET_DATA:
@@ -12262,6 +12263,7 @@ start:
 	case EXEC_OMP_MASKED_TASKLOOP_SIMD:
 	case EXEC_OMP_ORDERED:
 	case EXEC_OMP_SCAN:
+	case EXEC_OMP_SCOPE:
 	case EXEC_OMP_SECTIONS:
 	case EXEC_OMP_SIMD:
 	case EXEC_OMP_SINGLE:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index f61f88a..7d87709 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -246,6 +246,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_PARALLEL_SECTIONS:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_SCAN:
+    case EXEC_OMP_SCOPE:
     case EXEC_OMP_SECTIONS:
     case EXEC_OMP_SIMD:
     case EXEC_OMP_SINGLE:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 623c21f..e0a0014 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -6265,6 +6265,24 @@ gfc_trans_omp_parallel_workshare (gfc_code *code)
 }
 
 static tree
+gfc_trans_omp_scope (gfc_code *code)
+{
+  stmtblock_t block;
+  tree body = gfc_trans_code (code->block->next);
+  if (IS_EMPTY_STMT (body))
+    return body;
+  gfc_start_block (&block);
+  tree omp_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
+					    code->loc);
+  tree stmt = make_node (OMP_SCOPE);
+  TREE_TYPE (stmt) = void_type_node;
+  OMP_SCOPE_BODY (stmt) = body;
+  OMP_SCOPE_CLAUSES (stmt) = omp_clauses;
+  gfc_add_expr_to_block (&block, stmt);
+  return gfc_finish_block (&block);
+}
+
+static tree
 gfc_trans_omp_sections (gfc_code *code, gfc_omp_clauses *clauses)
 {
   stmtblock_t block, body;
@@ -7110,6 +7128,8 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_parallel_sections (code);
     case EXEC_OMP_PARALLEL_WORKSHARE:
       return gfc_trans_omp_parallel_workshare (code);
+    case EXEC_OMP_SCOPE:
+      return gfc_trans_omp_scope (code);
     case EXEC_OMP_SECTIONS:
       return gfc_trans_omp_sections (code, code->ext.omp_clauses);
     case EXEC_OMP_SINGLE:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ce5b2f8..80b724d0 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2175,6 +2175,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
 	case EXEC_OMP_PARALLEL_SECTIONS:
 	case EXEC_OMP_PARALLEL_WORKSHARE:
+	case EXEC_OMP_SCOPE:
 	case EXEC_OMP_SECTIONS:
 	case EXEC_OMP_SIMD:
 	case EXEC_OMP_SINGLE:
-- 
cgit v1.1


From 2d14d64bf2d42a87ec58dd3760be12aeaa4a4279 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 18 Aug 2021 00:16:48 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5b3744c..86a2bda 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,25 @@
+2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
+	EXEC_OMP_SCOPE.
+	* gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE.
+	(enum gfc_exec_op): Add EXEC_OMP_SCOPE.
+	* match.h (gfc_match_omp_scope): New.
+	* openmp.c (OMP_SCOPE_CLAUSES): Define
+	(gfc_match_omp_scope): New.
+	(gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait):
+	Improve error diagnostic.
+	(omp_code_to_statement): Handle ST_OMP_SCOPE.
+	(gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE.
+	* parse.c (decode_omp_directive, next_statement,
+	gfc_ascii_statement, parse_omp_structured_block,
+	parse_executable): Handle OpenMP's scope construct.
+	* resolve.c (gfc_resolve_blocks): Likewise
+	* st.c (gfc_free_statement): Likewise
+	* trans-openmp.c (gfc_trans_omp_scope): New.
+	(gfc_trans_omp_directive): Call it.
+	* trans.c (trans_code): handle EXEC_OMP_SCOPE.
+
 2021-08-16  Tobias Burnus  <tobias@codesourcery.com>
 
 	* dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause.
-- 
cgit v1.1


From f74433e70ae94a3b5291e45fea488b1cfdee4a34 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Wed, 18 Aug 2021 15:21:18 +0200
Subject: Fortran: Add OpenMP's nothing directive support

Fortran version of commit 5079b7781a2c506dcdfb241347d74c7891268225

gcc/fortran/ChangeLog:

	* match.h (gfc_match_omp_nothing): New.
	* openmp.c (gfc_match_omp_nothing): New.
	* parse.c (decode_omp_directive): Match 'nothing' directive.

gcc/testsuite/ChangeLog:

	* gfortran.dg/nothing-1.f90: New test.
	* gfortran.dg/nothing-2.f90: New test.
---
 gcc/fortran/match.h  |  1 +
 gcc/fortran/openmp.c | 11 +++++++++++
 gcc/fortran/parse.c  |  3 +++
 3 files changed, 15 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index aac16a8..5127b4b 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -175,6 +175,7 @@ match gfc_match_omp_masked_taskloop_simd (void);
 match gfc_match_omp_master (void);
 match gfc_match_omp_master_taskloop (void);
 match gfc_match_omp_master_taskloop_simd (void);
+match gfc_match_omp_nothing (void);
 match gfc_match_omp_ordered (void);
 match gfc_match_omp_ordered_depend (void);
 match gfc_match_omp_parallel (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 9675b65..fd219dc 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -4797,6 +4797,17 @@ gfc_match_omp_ordered (void)
   return match_omp (EXEC_OMP_ORDERED, OMP_ORDERED_CLAUSES);
 }
 
+match
+gfc_match_omp_nothing (void)
+{
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after $OMP NOTHING statement at %C");
+      return MATCH_ERROR;
+    }
+  /* Will use ST_NONE; therefore, no EXEC_OMP_ is needed.  */
+  return MATCH_YES;
+}
 
 match
 gfc_match_omp_ordered_depend (void)
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 24cc9bf..d004732 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1005,6 +1005,9 @@ decode_omp_directive (void)
 	      ST_OMP_MASTER_TASKLOOP);
       matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
       break;
+    case 'n':
+      matcho ("nothing", gfc_match_omp_nothing, ST_NONE);
+      break;
     case 'l':
       matcho ("loop", gfc_match_omp_loop, ST_OMP_LOOP);
       break;
-- 
cgit v1.1


From 6e529985d8956f74492e3176026fc02dc8f01b6c Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 19 Aug 2021 00:16:42 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 86a2bda..90a3e53 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-08-18  Tobias Burnus  <tobias@codesourcery.com>
+
+	* match.h (gfc_match_omp_nothing): New.
+	* openmp.c (gfc_match_omp_nothing): New.
+	* parse.c (decode_omp_directive): Match 'nothing' directive.
+
 2021-08-17  Tobias Burnus  <tobias@codesourcery.com>
 
 	* dump-parse-tree.c (show_omp_node, show_code_node): Handle
-- 
cgit v1.1


From d881460deb1f0bdfc3e8fa2d391a03a9763cbff4 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 19 Aug 2021 21:00:45 +0200
Subject: Fortran - simplify length of substring with constant bounds

gcc/fortran/ChangeLog:

	PR fortran/100950
	* simplify.c (substring_has_constant_len): New.
	(gfc_simplify_len): Handle case of substrings with constant
	bounds.

gcc/testsuite/ChangeLog:

	PR fortran/100950
	* gfortran.dg/pr100950.f90: New test.
---
 gcc/fortran/simplify.c | 75 +++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 74 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index c27b47a..492867e 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4512,6 +4512,78 @@ gfc_simplify_leadz (gfc_expr *e)
 }
 
 
+/* Check for constant length of a substring.  */
+
+static bool
+substring_has_constant_len (gfc_expr *e)
+{
+  gfc_ref *ref;
+  HOST_WIDE_INT istart, iend, length;
+  bool equal_length = false;
+
+  if (e->ts.type != BT_CHARACTER)
+    return false;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type != REF_COMPONENT && ref->type != REF_ARRAY)
+      break;
+
+  if (!ref
+      || ref->type != REF_SUBSTRING
+      || !ref->u.ss.start
+      || ref->u.ss.start->expr_type != EXPR_CONSTANT
+      || !ref->u.ss.end
+      || ref->u.ss.end->expr_type != EXPR_CONSTANT
+      || !ref->u.ss.length)
+    return false;
+
+  /* For non-deferred strings the given length shall be constant.  */
+  if (!e->ts.deferred
+      && (!ref->u.ss.length->length
+	  || ref->u.ss.length->length->expr_type != EXPR_CONSTANT))
+    return false;
+
+  /* Basic checks on substring starting and ending indices.  */
+  if (!gfc_resolve_substring (ref, &equal_length))
+    return false;
+
+  istart = gfc_mpz_get_hwi (ref->u.ss.start->value.integer);
+  iend = gfc_mpz_get_hwi (ref->u.ss.end->value.integer);
+
+  if (istart <= iend)
+    {
+      if (istart < 1)
+	{
+	  gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
+		     ") at %L below 1",
+		     istart, &ref->u.ss.start->where);
+	  return false;
+	}
+
+      /* For deferred strings use end index as proxy for length.  */
+      if (e->ts.deferred)
+	length = iend;
+      else
+	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
+      if (iend > length)
+	{
+	  gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
+		     ") at %L exceeds string length",
+		     iend, &ref->u.ss.end->where);
+	  return false;
+	}
+      length = iend - istart + 1;
+    }
+  else
+    length = 0;
+
+  /* Fix substring length.  */
+  e->value.character.length = length;
+
+  return true;
+}
+
+
 gfc_expr *
 gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
 {
@@ -4521,7 +4593,8 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind)
   if (k == -1)
     return &gfc_bad_expr;
 
-  if (e->expr_type == EXPR_CONSTANT)
+  if (e->expr_type == EXPR_CONSTANT
+      || substring_has_constant_len (e))
     {
       result = gfc_get_constant_expr (BT_INTEGER, k, &e->where);
       mpz_set_si (result->value.integer, e->value.character.length);
-- 
cgit v1.1


From b57fba5e376c7277168c14e207979e1505e6fe1d Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 20 Aug 2021 00:16:28 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 90a3e53..8bf8cde 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-08-19  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100950
+	* simplify.c (substring_has_constant_len): New.
+	(gfc_simplify_len): Handle case of substrings with constant
+	bounds.
+
 2021-08-18  Tobias Burnus  <tobias@codesourcery.com>
 
 	* match.h (gfc_match_omp_nothing): New.
-- 
cgit v1.1


From 0d973c0a0d90a0a302e7eda1a4d9709be3c5b102 Mon Sep 17 00:00:00 2001
From: Jakub Jelinek <jakub@redhat.com>
Date: Fri, 20 Aug 2021 11:36:52 +0200
Subject: openmp: Implement the error directive

This patch implements the error directive.  Depending on clauses it is either
a compile time diagnostics (in that case diagnosed right away) or runtime
diagnostics (libgomp API call that diagnoses at runtime), and either fatal
or warning (error or warning at compile time or fatal error vs. error at
runtime) and either has no message or user supplied message (this kind of
e.g. deprecated attribute).  The directive is also stand-alone directive
when at runtime while utility (thus disappears from the IL as if it wasn't
there for parsing like nothing directive) at compile time.

There are some clarifications in the works ATM, so this patch doesn't yet
require that for compile time diagnostics the user message must be a constant
string literal, there are uncertainities on what exactly is valid argument
of message clause (whether just const char * type, convertible to const char *,
qualified/unqualified const char * or char * or what else) and what to do
in templates.  Currently even in templates it is diagnosed right away for
compile time diagnostics, if we'll need to substitute it, we'd need to queue
something into the IL, have pt.c handle it and diagnose only later.

2021-08-20  Jakub Jelinek  <jakub@redhat.com>

gcc/
	* omp-builtins.def (BUILT_IN_GOMP_WARNING, BUILT_IN_GOMP_ERROR): New
	builtins.
gcc/c-family/
	* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_ERROR.
	* c-pragma.c (omp_pragmas): Add error directive.
	* c-omp.c (omp_directives): Uncomment error directive entry.
gcc/c/
	* c-parser.c (c_parser_omp_error): New function.
	(c_parser_pragma): Handle PRAGMA_OMP_ERROR.
gcc/cp/
	* parser.c (cp_parser_handle_statement_omp_attributes): Determine if
	PRAGMA_OMP_ERROR directive is C_OMP_DIR_STANDALONE.
	(cp_parser_omp_error): New function.
	(cp_parser_pragma): Handle PRAGMA_OMP_ERROR.
gcc/fortran/
	* types.def (BT_FN_VOID_CONST_PTR_SIZE): New DEF_FUNCTION_TYPE_2.
	* f95-lang.c (ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST): Define.
gcc/testsuite/
	* c-c++-common/gomp/error-1.c: New test.
	* c-c++-common/gomp/error-2.c: New test.
	* c-c++-common/gomp/error-3.c: New test.
	* g++.dg/gomp/attrs-1.C (bar): Add error directive test.
	* g++.dg/gomp/attrs-2.C (bar): Add error directive test.
	* g++.dg/gomp/attrs-13.C: New test.
	* g++.dg/gomp/error-1.C: New test.
libgomp/
	* libgomp.map (GOMP_5.1): Add GOMP_error and GOMP_warning.
	* libgomp_g.h (GOMP_warning, GOMP_error): Declare.
	* error.c (GOMP_warning, GOMP_error): New functions.
	* testsuite/libgomp.c-c++-common/error-1.c: New test.
---
 gcc/fortran/f95-lang.c | 5 ++++-
 gcc/fortran/types.def  | 1 +
 2 files changed, 5 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 5fc8481..026228d 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -535,7 +535,7 @@ gfc_builtin_function (tree decl)
   return decl;
 }
 
-/* So far we need just these 8 attribute types.  */
+/* So far we need just these 10 attribute types.  */
 #define ATTR_NULL			0
 #define ATTR_LEAF_LIST			(ECF_LEAF)
 #define ATTR_NOTHROW_LEAF_LIST		(ECF_NOTHROW | ECF_LEAF)
@@ -546,6 +546,9 @@ gfc_builtin_function (tree decl)
 #define ATTR_CONST_NOTHROW_LIST		(ECF_NOTHROW | ECF_CONST)
 #define ATTR_ALLOC_WARN_UNUSED_RESULT_SIZE_2_NOTHROW_LIST \
 					(ECF_NOTHROW)
+#define ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST \
+					(ECF_COLD | ECF_NORETURN | \
+					 ECF_NOTHROW | ECF_LEAF)
 
 static void
 gfc_define_builtin (const char *name, tree type, enum built_in_function code,
diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def
index 8626ed0..85b85ed 100644
--- a/gcc/fortran/types.def
+++ b/gcc/fortran/types.def
@@ -120,6 +120,7 @@ DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_INT_BOOL, BT_BOOL, BT_INT, BT_BOOL)
 DEF_FUNCTION_TYPE_2 (BT_FN_VOID_UINT_UINT, BT_VOID, BT_UINT, BT_UINT)
 DEF_FUNCTION_TYPE_2 (BT_FN_VOID_PTR_PTRMODE,
 		     BT_VOID, BT_PTR, BT_PTRMODE)
+DEF_FUNCTION_TYPE_2 (BT_FN_VOID_CONST_PTR_SIZE, BT_VOID, BT_CONST_PTR, BT_SIZE)
 
 DEF_POINTER_TYPE (BT_PTR_FN_VOID_PTR_PTR, BT_FN_VOID_PTR_PTR)
 
-- 
cgit v1.1


From 77167196fe8cf840a69913e7739d39ae0df2b074 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 20 Aug 2021 12:12:51 +0200
Subject: Fortran: Add OpenMP's error directive

Fortran part to the C/C++ implementation of
commit r12-3040-g0d973c0a0d90a0a302e7eda1a4d9709be3c5b102

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity'
	and 'message' clauses.
	(show_omp_node, show_code_node): Handle EXEC_OMP_ERROR.
	* gfortran.h (gfc_statement): Add ST_OMP_ERROR.
	(gfc_omp_severity_type, gfc_omp_at_type): New.
	(gfc_omp_clauses): Add 'at', 'severity' and 'message' clause;
	use more bitfields + ENUM_BITFIELD.
	(gfc_exec_op): Add EXEC_OMP_ERROR.
	* match.h (gfc_match_omp_error): New.
	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE).
	(gfc_match_omp_clauses): Handle new clauses.
	(OMP_ERROR_CLAUSES, gfc_match_omp_error): New.
	(resolve_omp_clauses): Resolve new clauses.
	(omp_code_to_statement, gfc_resolve_omp_directive): Handle
	EXEC_OMP_ERROR.
	* parse.c (decode_omp_directive, next_statement,
	gfc_ascii_statement): Handle 'omp error'.
	* resolve.c (gfc_resolve_blocks): Likewise.
	* st.c (gfc_free_statement): Likewise.
	* trans-openmp.c (gfc_trans_omp_error): Likewise.
	(gfc_trans_omp_directive): Likewise.
	* trans.c (trans_code): Likewise.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/error-1.f90: New test.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/error-1.f90: New test.
	* gfortran.dg/gomp/error-2.f90: New test.
	* gfortran.dg/gomp/error-3.f90: New test.
---
 gcc/fortran/dump-parse-tree.c |  27 ++++++++-
 gcc/fortran/gfortran.h        |  58 +++++++++++++-------
 gcc/fortran/match.h           |   1 +
 gcc/fortran/openmp.c          | 124 +++++++++++++++++++++++++++++++++++++++++-
 gcc/fortran/parse.c           |  10 +++-
 gcc/fortran/resolve.c         |   2 +
 gcc/fortran/st.c              |   1 +
 gcc/fortran/trans-openmp.c    |  34 ++++++++++++
 gcc/fortran/trans.c           |   1 +
 9 files changed, 233 insertions(+), 25 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 92d9f9e..c75a0a9 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1908,6 +1908,26 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       fputc (' ', dumpfile);
       fputs (memorder, dumpfile);
     }
+  if (omp_clauses->at != OMP_AT_UNSET)
+    {
+      if (omp_clauses->at != OMP_AT_COMPILATION)
+	fputs (" AT (COMPILATION)", dumpfile);
+      else
+	fputs (" AT (EXECUTION)", dumpfile);
+    }
+  if (omp_clauses->severity != OMP_SEVERITY_UNSET)
+    {
+      if (omp_clauses->severity != OMP_SEVERITY_FATAL)
+	fputs (" SEVERITY (FATAL)", dumpfile);
+      else
+	fputs (" SEVERITY (WARNING)", dumpfile);
+    }
+  if (omp_clauses->message)
+    {
+      fputs (" ERROR (", dumpfile);
+      show_expr (omp_clauses->message);
+      fputc (')', dumpfile);
+    }
 }
 
 /* Show a single OpenMP or OpenACC directive node and everything underneath it
@@ -1950,8 +1970,9 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DISTRIBUTE_SIMD: name = "DISTRIBUTE SIMD"; break;
     case EXEC_OMP_DO: name = "DO"; break;
     case EXEC_OMP_DO_SIMD: name = "DO SIMD"; break;
-    case EXEC_OMP_LOOP: name = "LOOP"; break;
+    case EXEC_OMP_ERROR: name = "ERROR"; break;
     case EXEC_OMP_FLUSH: name = "FLUSH"; break;
+    case EXEC_OMP_LOOP: name = "LOOP"; break;
     case EXEC_OMP_MASKED: name = "MASKED"; break;
     case EXEC_OMP_MASKED_TASKLOOP: name = "MASKED TASKLOOP"; break;
     case EXEC_OMP_MASKED_TASKLOOP_SIMD: name = "MASKED TASKLOOP SIMD"; break;
@@ -2045,6 +2066,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OMP_DISTRIBUTE_SIMD:
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
+    case EXEC_OMP_ERROR:
     case EXEC_OMP_LOOP:
     case EXEC_OMP_ORDERED:
     case EXEC_OMP_MASKED:
@@ -2135,7 +2157,7 @@ show_omp_node (int level, gfc_code *c)
       || c->op == EXEC_OACC_ENTER_DATA || c->op == EXEC_OACC_EXIT_DATA
       || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
       || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
-      || c->op == EXEC_OMP_DEPOBJ
+      || c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR
       || (c->op == EXEC_OMP_ORDERED && c->block == NULL))
     return;
   if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -3268,6 +3290,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_DISTRIBUTE_SIMD:
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
+    case EXEC_OMP_ERROR:
     case EXEC_OMP_FLUSH:
     case EXEC_OMP_LOOP:
     case EXEC_OMP_MASKED:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a7d82ae..4b26cb4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -281,7 +281,8 @@ enum gfc_statement
   ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
   ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD, ST_OMP_MASKED_TASKLOOP,
   ST_OMP_END_MASKED_TASKLOOP, ST_OMP_MASKED_TASKLOOP_SIMD,
-  ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE, ST_NONE
+  ST_OMP_END_MASKED_TASKLOOP_SIMD, ST_OMP_SCOPE, ST_OMP_END_SCOPE,
+  ST_OMP_ERROR, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -776,6 +777,20 @@ enum gfc_omp_device_type
   OMP_DEVICE_TYPE_ANY
 };
 
+enum gfc_omp_severity_type
+{
+  OMP_SEVERITY_UNSET,
+  OMP_SEVERITY_WARNING,
+  OMP_SEVERITY_FATAL
+};
+
+enum gfc_omp_at_type
+{
+  OMP_AT_UNSET,
+  OMP_AT_COMPILATION,
+  OMP_AT_EXECUTION
+};
+
 /* Structure and list of supported extension attributes.  */
 typedef enum
 {
@@ -1446,26 +1461,11 @@ enum gfc_omp_bind_type
 
 typedef struct gfc_omp_clauses
 {
+  gfc_omp_namelist *lists[OMP_LIST_NUM];
   struct gfc_expr *if_expr;
   struct gfc_expr *final_expr;
   struct gfc_expr *num_threads;
-  gfc_omp_namelist *lists[OMP_LIST_NUM];
-  enum gfc_omp_sched_kind sched_kind;
-  enum gfc_omp_device_type device_type;
   struct gfc_expr *chunk_size;
-  enum gfc_omp_default_sharing default_sharing;
-  enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
-  int collapse, orderedc;
-  bool nowait, ordered, untied, mergeable;
-  bool inbranch, notinbranch, nogroup;
-  bool sched_simd, sched_monotonic, sched_nonmonotonic;
-  bool simd, threads, depend_source, destroy, order_concurrent, capture;
-  enum gfc_omp_atomic_op atomic_op;
-  enum gfc_omp_memorder memorder;
-  enum gfc_omp_cancel_kind cancel;
-  enum gfc_omp_proc_bind_kind proc_bind;
-  enum gfc_omp_depend_op depobj_update;
-  enum gfc_omp_bind_type bind;
   struct gfc_expr *safelen_expr;
   struct gfc_expr *simdlen_expr;
   struct gfc_expr *num_teams;
@@ -1479,9 +1479,28 @@ typedef struct gfc_omp_clauses
   struct gfc_expr *detach;
   struct gfc_expr *depobj;
   struct gfc_expr *if_exprs[OMP_IF_LAST];
-  enum gfc_omp_sched_kind dist_sched_kind;
   struct gfc_expr *dist_chunk_size;
+  struct gfc_expr *message;
   const char *critical_name;
+  enum gfc_omp_default_sharing default_sharing;
+  enum gfc_omp_atomic_op atomic_op;
+  enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
+  int collapse, orderedc;
+  unsigned nowait:1, ordered:1, untied:1, mergeable:1;
+  unsigned inbranch:1, notinbranch:1, nogroup:1;
+  unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
+  unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
+  unsigned capture:1;
+  ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
+  ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
+  ENUM_BITFIELD (gfc_omp_memorder) memorder:3;
+  ENUM_BITFIELD (gfc_omp_cancel_kind) cancel:3;
+  ENUM_BITFIELD (gfc_omp_proc_bind_kind) proc_bind:3;
+  ENUM_BITFIELD (gfc_omp_depend_op) depobj_update:3;
+  ENUM_BITFIELD (gfc_omp_bind_type) bind:2;
+  ENUM_BITFIELD (gfc_omp_at_type) at:2;
+  ENUM_BITFIELD (gfc_omp_severity_type) severity:2;
+  ENUM_BITFIELD (gfc_omp_sched_kind) dist_sched_kind:3;
 
   /* OpenACC. */
   struct gfc_expr *async_expr;
@@ -2768,7 +2787,8 @@ enum gfc_exec_op
   EXEC_OMP_TEAMS_LOOP, EXEC_OMP_TARGET_PARALLEL_LOOP,
   EXEC_OMP_TARGET_TEAMS_LOOP, EXEC_OMP_MASKED, EXEC_OMP_PARALLEL_MASKED,
   EXEC_OMP_PARALLEL_MASKED_TASKLOOP, EXEC_OMP_PARALLEL_MASKED_TASKLOOP_SIMD,
-  EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE
+  EXEC_OMP_MASKED_TASKLOOP, EXEC_OMP_MASKED_TASKLOOP_SIMD, EXEC_OMP_SCOPE,
+  EXEC_OMP_ERROR
 };
 
 typedef struct gfc_code
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 5127b4b..92fd127 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -168,6 +168,7 @@ match gfc_match_omp_distribute_simd (void);
 match gfc_match_omp_do (void);
 match gfc_match_omp_do_simd (void);
 match gfc_match_omp_loop (void);
+match gfc_match_omp_error (void);
 match gfc_match_omp_flush (void);
 match gfc_match_omp_masked (void);
 match gfc_match_omp_masked_taskloop (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index fd219dc..2380866 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -28,6 +28,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "constructor.h"
 #include "diagnostic.h"
 #include "gomp-constants.h"
+#include "target-memory.h"  /* For gfc_encode_character.  */
 
 /* Match an end of OpenMP directive.  End of OpenMP directive is optional
    whitespace, followed by '\n' or comment '!'.  */
@@ -848,6 +849,9 @@ enum omp_mask1
   OMP_CLAUSE_AFFINITY,  /* OpenMP 5.0.  */
   OMP_CLAUSE_BIND,  /* OpenMP 5.0.  */
   OMP_CLAUSE_FILTER,  /* OpenMP 5.1.  */
+  OMP_CLAUSE_AT,  /* OpenMP 5.1.  */
+  OMP_CLAUSE_MESSAGE,  /* OpenMP 5.1.  */
+  OMP_CLAUSE_SEVERITY,  /* OpenMP 5.1.  */
   OMP_CLAUSE_NOWAIT,
   /* This must come last.  */
   OMP_MASK1_LAST
@@ -1293,6 +1297,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		       bool first = true, bool needs_space = true,
 		       bool openacc = false)
 {
+  bool error = false;
   gfc_omp_clauses *c = gfc_get_omp_clauses ();
   locus old_loc;
   /* Determine whether we're dealing with an OpenACC directive that permits
@@ -1392,6 +1397,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		}
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_AT)
+	      && c->at == OMP_AT_UNSET
+	      && gfc_match ("at ( ") == MATCH_YES)
+	    {
+	      if (gfc_match ("compilation )") == MATCH_YES)
+		c->at = OMP_AT_COMPILATION;
+	      else if (gfc_match ("execution )") == MATCH_YES)
+		c->at = OMP_AT_EXECUTION;
+	      else
+		{
+		  gfc_error ("Expected COMPILATION or EXECUTION in AT clause "
+			     "at %C");
+		  goto error;
+		}
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_ASYNC)
 	      && !c->async
 	      && gfc_match ("async") == MATCH_YES)
@@ -1616,7 +1637,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		     else
 		      gfc_error ("DEFAULTMAP at %C but prior DEFAULTMAP for "
 				 "category %s", pcategory);
-		     goto end;
+		     goto error;
 		    }
 		}
 	      c->defaultmap[category] = behavior;
@@ -2074,6 +2095,10 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      c->mergeable = needs_space = true;
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_MESSAGE)
+	      && !c->message
+	      && gfc_match ("message ( %e )", &c->message) == MATCH_YES)
+	    continue;
 	  break;
 	case 'n':
 	  if ((mask & OMP_CLAUSE_NO_CREATE)
@@ -2402,6 +2427,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      c->simd = needs_space = true;
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_SEVERITY)
+	      && c->severity == OMP_SEVERITY_UNSET
+	      && gfc_match ("severity ( ") == MATCH_YES)
+	    {
+	      if (gfc_match ("fatal )") == MATCH_YES)
+		c->severity = OMP_SEVERITY_FATAL;
+	      else if (gfc_match ("warning )") == MATCH_YES)
+		c->severity = OMP_SEVERITY_WARNING;
+	      else
+		{
+		  gfc_error ("Expected FATAL or WARNING in SEVERITY clause "
+			     "at %C");
+		  goto error;
+		}
+	      continue;
+	    }
 	  break;
 	case 't':
 	  if ((mask & OMP_CLAUSE_TASK_REDUCTION)
@@ -2553,7 +2594,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
     }
 
 end:
-  if (gfc_match_omp_eos () != MATCH_YES)
+  if (error || gfc_match_omp_eos () != MATCH_YES)
     {
       if (!gfc_error_flag_test ())
 	gfc_error ("Failed to match clause at %C");
@@ -2563,6 +2604,10 @@ end:
 
   *cp = c;
   return MATCH_YES;
+
+error:
+  error = true;
+  goto end;
 }
 
 
@@ -3208,6 +3253,9 @@ cleanup:
    | OMP_CLAUSE_MEMORDER)
 #define OMP_MASKED_CLAUSES \
   (omp_mask (OMP_CLAUSE_FILTER))
+#define OMP_ERROR_CLAUSES \
+  (omp_mask (OMP_CLAUSE_AT) | OMP_CLAUSE_MESSAGE | OMP_CLAUSE_SEVERITY)
+
 
 
 static match
@@ -3432,6 +3480,66 @@ gfc_match_omp_target_parallel_loop (void)
 
 
 match
+gfc_match_omp_error (void)
+{
+  locus loc = gfc_current_locus;
+  match m = match_omp (EXEC_OMP_ERROR, OMP_ERROR_CLAUSES);
+  if (m != MATCH_YES)
+    return m;
+
+  gfc_omp_clauses *c = new_st.ext.omp_clauses;
+  if (c->severity == OMP_SEVERITY_UNSET)
+    c->severity = OMP_SEVERITY_FATAL;
+  if (new_st.ext.omp_clauses->at == OMP_AT_EXECUTION)
+    return MATCH_YES;
+  if (c->message
+      && (!gfc_resolve_expr (c->message)
+	  || c->message->ts.type != BT_CHARACTER
+	  || c->message->ts.kind != gfc_default_character_kind
+	  || c->message->rank != 0))
+    {
+      gfc_error ("MESSAGE clause at %L requires a scalar default-kind "
+		   "CHARACTER expression",
+		 &new_st.ext.omp_clauses->message->where);
+      return MATCH_ERROR;
+    }
+  if (c->message && !gfc_is_constant_expr (c->message))
+    {
+      gfc_error ("Constant character expression required in MESSAGE clause "
+		 "at %L", &new_st.ext.omp_clauses->message->where);
+      return MATCH_ERROR;
+    }
+  if (c->message)
+    {
+      const char *msg = G_("$OMP ERROR encountered at %L: %s");
+      gcc_assert (c->message->expr_type == EXPR_CONSTANT);
+      gfc_charlen_t slen = c->message->value.character.length;
+      int i = gfc_validate_kind (BT_CHARACTER, gfc_default_character_kind,
+				 false);
+      size_t size = slen * gfc_character_kinds[i].bit_size / 8;
+      unsigned char *s = XCNEWVAR (unsigned char, size + 1);
+      gfc_encode_character (gfc_default_character_kind, slen,
+			    c->message->value.character.string,
+			    (unsigned char *) s, size);
+      s[size] = '\0';
+      if (c->severity == OMP_SEVERITY_WARNING)
+	gfc_warning_now (0, msg, &loc, s);
+      else
+	gfc_error_now (msg, &loc, s);
+      free (s);
+    }
+  else
+    {
+      const char *msg = G_("$OMP ERROR encountered at %L");
+      if (c->severity == OMP_SEVERITY_WARNING)
+	gfc_warning_now (0, msg, &loc);
+      else
+	gfc_error_now (msg, &loc);
+    }
+  return MATCH_YES;
+}
+
+match
 gfc_match_omp_flush (void)
 {
   gfc_omp_namelist *list = NULL;
@@ -6463,6 +6571,15 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
   if (omp_clauses->depend_source && code->op != EXEC_OMP_ORDERED)
     gfc_error ("SOURCE dependence type only allowed "
 	       "on ORDERED directive at %L", &code->loc);
+  if (omp_clauses->message)
+    {
+      gfc_expr *expr = omp_clauses->message;
+      if (!gfc_resolve_expr (expr)
+	  || expr->ts.kind != gfc_default_character_kind
+	  || expr->ts.type != BT_CHARACTER || expr->rank != 0)
+	gfc_error ("MESSAGE clause at %L requires a scalar default-kind "
+		   "CHARACTER expression", &expr->where);
+    }
   if (!openacc
       && code
       && omp_clauses->lists[OMP_LIST_MAP] == NULL
@@ -7461,6 +7578,8 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_CANCEL;
     case EXEC_OMP_CANCELLATION_POINT:
       return ST_OMP_CANCELLATION_POINT;
+    case EXEC_OMP_ERROR:
+      return ST_OMP_ERROR;
     case EXEC_OMP_FLUSH:
       return ST_OMP_FLUSH;
     case EXEC_OMP_DISTRIBUTE:
@@ -7971,6 +8090,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
       resolve_omp_do (code);
       break;
     case EXEC_OMP_CANCEL:
+    case EXEC_OMP_ERROR:
     case EXEC_OMP_MASKED:
     case EXEC_OMP_PARALLEL_WORKSHARE:
     case EXEC_OMP_PARALLEL:
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index d004732..d37a0b5 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -908,6 +908,7 @@ decode_omp_directive (void)
       matcho ("do", gfc_match_omp_do, ST_OMP_DO);
       break;
     case 'e':
+      matcho ("error", gfc_match_omp_error, ST_OMP_ERROR);
       matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC);
       matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL);
       matchs ("end distribute parallel do simd", gfc_match_omp_eos_error,
@@ -1183,6 +1184,9 @@ decode_omp_directive (void)
 	  prog_unit->omp_target_seen = true;
 	break;
       }
+    case ST_OMP_ERROR:
+      if (new_st.ext.omp_clauses->at != OMP_AT_EXECUTION)
+	return ST_NONE;
     default:
       break;
     }
@@ -1654,7 +1658,7 @@ next_statement (void)
   case ST_OMP_BARRIER: case ST_OMP_TASKWAIT: case ST_OMP_TASKYIELD: \
   case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
   case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
-  case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: \
+  case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \
   case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
   case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
   case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
@@ -1716,7 +1720,6 @@ next_statement (void)
   case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
   case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
 
-
 /* Block end statements.  Errors associated with interchanging these
    are detected in gfc_match_end().  */
 
@@ -2544,6 +2547,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_WORKSHARE:
       p = "!$OMP END WORKSHARE";
       break;
+    case ST_OMP_ERROR:
+      p = "!$OMP ERROR";
+      break;
     case ST_OMP_FLUSH:
       p = "!$OMP FLUSH";
       break;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 117062b..5b9ba43 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -10817,6 +10817,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OMP_DISTRIBUTE_SIMD:
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
+	case EXEC_OMP_ERROR:
 	case EXEC_OMP_LOOP:
 	case EXEC_OMP_MASKED:
 	case EXEC_OMP_MASKED_TASKLOOP:
@@ -12254,6 +12255,7 @@ start:
 	case EXEC_OMP_DISTRIBUTE_SIMD:
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
+	case EXEC_OMP_ERROR:
 	case EXEC_OMP_LOOP:
 	case EXEC_OMP_MASTER:
 	case EXEC_OMP_MASTER_TASKLOOP:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 7d87709..6bf730c 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -225,6 +225,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_DISTRIBUTE_SIMD:
     case EXEC_OMP_DO:
     case EXEC_OMP_DO_SIMD:
+    case EXEC_OMP_ERROR:
     case EXEC_OMP_LOOP:
     case EXEC_OMP_END_SINGLE:
     case EXEC_OMP_MASKED_TASKLOOP:
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index e0a0014..91888f3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -5369,6 +5369,38 @@ gfc_trans_omp_depobj (gfc_code *code)
 }
 
 static tree
+gfc_trans_omp_error (gfc_code *code)
+{
+  stmtblock_t block;
+  gfc_se se;
+  tree len, message;
+  bool fatal = code->ext.omp_clauses->severity == OMP_SEVERITY_FATAL;
+  tree fndecl = builtin_decl_explicit (fatal ? BUILT_IN_GOMP_ERROR
+					     : BUILT_IN_GOMP_WARNING);
+  gfc_start_block (&block);
+  gfc_init_se (&se, NULL );
+  if (!code->ext.omp_clauses->message)
+    {
+      message = null_pointer_node;
+      len = build_int_cst (size_type_node, 0);
+    }
+  else
+    {
+      gfc_conv_expr (&se, code->ext.omp_clauses->message);
+      message = se.expr;
+      if (!POINTER_TYPE_P (TREE_TYPE (message)))
+	/* To ensure an ARRAY_TYPE is not passed as such.  */
+	message = gfc_build_addr_expr (NULL, message);
+      len = se.string_length;
+    }
+  gfc_add_block_to_block (&block, &se.pre);
+  gfc_add_expr_to_block (&block, build_call_expr_loc (input_location, fndecl,
+						      2, message, len));
+  gfc_add_block_to_block (&block, &se.post);
+  return gfc_finish_block (&block);
+}
+
+static tree
 gfc_trans_omp_flush (gfc_code *code)
 {
   tree call;
@@ -7096,6 +7128,8 @@ gfc_trans_omp_directive (gfc_code *code)
       return gfc_trans_omp_distribute (code, NULL);
     case EXEC_OMP_DO_SIMD:
       return gfc_trans_omp_do_simd (code, NULL, NULL, NULL_TREE);
+    case EXEC_OMP_ERROR:
+      return gfc_trans_omp_error (code);
     case EXEC_OMP_FLUSH:
       return gfc_trans_omp_flush (code);
     case EXEC_OMP_MASKED:
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 80b724d0..eb5682a 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -2155,6 +2155,7 @@ trans_code (gfc_code * code, tree cond)
 	case EXEC_OMP_DO:
 	case EXEC_OMP_DO_SIMD:
 	case EXEC_OMP_LOOP:
+	case EXEC_OMP_ERROR:
 	case EXEC_OMP_FLUSH:
 	case EXEC_OMP_MASKED:
 	case EXEC_OMP_MASKED_TASKLOOP:
-- 
cgit v1.1


From 12f22906d3c025e7edb60e3264dc9cd27a49e3e1 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 20 Aug 2021 13:38:00 +0200
Subject: Fortran - use temporary char buffer for passing HOST_WIDE_INT to
 gfc_error

gcc/fortran/ChangeLog:

	PR fortran/100950
	* simplify.c (substring_has_constant_len): Fix format string of
	gfc_error, pass HOST_WIDE_INT bounds values via char buffer.
---
 gcc/fortran/simplify.c | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 492867e..eaabbff 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4552,11 +4552,12 @@ substring_has_constant_len (gfc_expr *e)
 
   if (istart <= iend)
     {
+      char buffer[21];
       if (istart < 1)
 	{
-	  gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC
-		     ") at %L below 1",
-		     istart, &ref->u.ss.start->where);
+	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
+	  gfc_error ("Substring start index (%s) at %L below 1",
+		     buffer, &ref->u.ss.start->where);
 	  return false;
 	}
 
@@ -4567,9 +4568,9 @@ substring_has_constant_len (gfc_expr *e)
 	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
       if (iend > length)
 	{
-	  gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC
-		     ") at %L exceeds string length",
-		     iend, &ref->u.ss.end->where);
+	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
+	  gfc_error ("Substring end index (%s) at %L exceeds string length",
+		     buffer, &ref->u.ss.end->where);
 	  return false;
 	}
       length = iend - istart + 1;
-- 
cgit v1.1


From 1b507b1e3c58c063b9cf803dff80c28d4626cb5d Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 20 Aug 2021 15:43:32 +0200
Subject: c-format.c/Fortran: Support %wd / host-wide integer in gfc_error

This patch adds support for the 'll' (long double)
and 'w' (HOST_WIDE_INT) length modifiers to the
Fortran FE diagnostic function (gfc_error, gfc_warning, ...)

gcc/c-family/ChangeLog:

	* c-format.c (gcc_gfc_length_specs): Add 'll' and 'w'.
	(gcc_gfc_char_table): Add T9L_LL and T9L_ULL to
	"di" and "u", respecitively; fill with BADLEN to match
	size of 'types'.
	(get_init_dynamic_hwi): Split off from ...
	(init_dynamic_diag_info): ... here. Call it.
	(init_dynamic_gfc_info): Call it.

gcc/fortran/ChangeLog:

	* error.c
	(error_uinteger): Take 'long long unsigned' instead
	of 'long unsigned' as argumpent.
	(error_integer): Take 'long long' instead of 'long'.
	(error_hwuint, error_hwint): New.
	(error_print): Update to handle 'll' and 'w'
	length modifiers.
	* simplify.c (substring_has_constant_len): Use '%wd'
	in gfc_error.
---
 gcc/fortran/error.c    | 106 +++++++++++++++++++++++++++++++++++++++++++++----
 gcc/fortran/simplify.c |  11 ++---
 2 files changed, 103 insertions(+), 14 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 529d97f..5e6e873 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -136,7 +136,7 @@ error_string (const char *p)
 #define IBUF_LEN 60
 
 static void
-error_uinteger (unsigned long int i)
+error_uinteger (unsigned long long int i)
 {
   char *p, int_buf[IBUF_LEN];
 
@@ -156,13 +156,50 @@ error_uinteger (unsigned long int i)
 }
 
 static void
-error_integer (long int i)
+error_integer (long long int i)
 {
-  unsigned long int u;
+  unsigned long long int u;
 
   if (i < 0)
     {
-      u = (unsigned long int) -i;
+      u = (unsigned long long int) -i;
+      error_char ('-');
+    }
+  else
+    u = i;
+
+  error_uinteger (u);
+}
+
+
+static void
+error_hwuint (unsigned HOST_WIDE_INT i)
+{
+  char *p, int_buf[IBUF_LEN];
+
+  p = int_buf + IBUF_LEN - 1;
+  *p-- = '\0';
+
+  if (i == 0)
+    *p-- = '0';
+
+  while (i > 0)
+    {
+      *p-- = i % 10 + '0';
+      i = i / 10;
+    }
+
+  error_string (p + 1);
+}
+
+static void
+error_hwint (HOST_WIDE_INT i)
+{
+  unsigned HOST_WIDE_INT u;
+
+  if (i < 0)
+    {
+      u = (unsigned HOST_WIDE_INT) -i;
       error_char ('-');
     }
   else
@@ -482,8 +519,8 @@ static void ATTRIBUTE_GCC_GFC(2,0)
 error_print (const char *type, const char *format0, va_list argp)
 {
   enum { TYPE_CURRENTLOC, TYPE_LOCUS, TYPE_INTEGER, TYPE_UINTEGER,
-         TYPE_LONGINT, TYPE_ULONGINT, TYPE_CHAR, TYPE_STRING,
-	 NOTYPE };
+	 TYPE_LONGINT, TYPE_ULONGINT, TYPE_LLONGINT, TYPE_ULLONGINT,
+	 TYPE_HWINT, TYPE_HWUINT, TYPE_CHAR, TYPE_STRING, NOTYPE };
   struct
   {
     int type;
@@ -494,6 +531,10 @@ error_print (const char *type, const char *format0, va_list argp)
       unsigned int uintval;
       long int longintval;
       unsigned long int ulongintval;
+      long long int llongintval;
+      unsigned long long int ullongintval;
+      HOST_WIDE_INT hwintval;
+      unsigned HOST_WIDE_INT hwuintval;
       char charval;
       const char * stringval;
     } u;
@@ -577,7 +618,17 @@ error_print (const char *type, const char *format0, va_list argp)
 
 	  case 'l':
 	    c = *format++;
-	    if (c == 'u')
+	    if (c == 'l')
+	      {
+		c = *format++;
+		if (c == 'u')
+		  arg[pos].type = TYPE_ULLONGINT;
+		else if (c == 'i' || c == 'd')
+		  arg[pos].type = TYPE_LLONGINT;
+		else
+		  gcc_unreachable ();
+	      }
+	    else if (c == 'u')
 	      arg[pos].type = TYPE_ULONGINT;
 	    else if (c == 'i' || c == 'd')
 	      arg[pos].type = TYPE_LONGINT;
@@ -585,6 +636,16 @@ error_print (const char *type, const char *format0, va_list argp)
 	      gcc_unreachable ();
 	    break;
 
+	  case 'w':
+	    c = *format++;
+	    if (c == 'u')
+	      arg[pos].type = TYPE_HWUINT;
+	    else if (c == 'i' || c == 'd')
+	      arg[pos].type = TYPE_HWINT;
+	    else
+	      gcc_unreachable ();
+	    break;
+
 	  case 'c':
 	    arg[pos].type = TYPE_CHAR;
 	    break;
@@ -649,6 +710,22 @@ error_print (const char *type, const char *format0, va_list argp)
 	    arg[pos].u.ulongintval = va_arg (argp, unsigned long int);
 	    break;
 
+	  case TYPE_LLONGINT:
+	    arg[pos].u.llongintval = va_arg (argp, long long int);
+	    break;
+
+	  case TYPE_ULLONGINT:
+	    arg[pos].u.ullongintval = va_arg (argp, unsigned long long int);
+	    break;
+
+	  case TYPE_HWINT:
+	    arg[pos].u.hwintval = va_arg (argp, HOST_WIDE_INT);
+	    break;
+
+	  case TYPE_HWUINT:
+	    arg[pos].u.hwuintval = va_arg (argp, unsigned HOST_WIDE_INT);
+	    break;
+
 	  case TYPE_CHAR:
 	    arg[pos].u.charval = (char) va_arg (argp, int);
 	    break;
@@ -725,12 +802,27 @@ error_print (const char *type, const char *format0, va_list argp)
 
 	case 'l':
 	  format++;
+	  if (*format == 'l')
+	    {
+	      format++;
+	      if (*format == 'u')
+		error_uinteger (spec[n++].u.ullongintval);
+	      else
+		error_integer (spec[n++].u.llongintval);
+	    }
 	  if (*format == 'u')
 	    error_uinteger (spec[n++].u.ulongintval);
 	  else
 	    error_integer (spec[n++].u.longintval);
 	  break;
 
+	case 'w':
+	  format++;
+	  if (*format == 'u')
+	    error_hwuint (spec[n++].u.hwintval);
+	  else
+	    error_hwint (spec[n++].u.hwuintval);
+	  break;
 	}
     }
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index eaabbff..4cb73e8 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4552,12 +4552,10 @@ substring_has_constant_len (gfc_expr *e)
 
   if (istart <= iend)
     {
-      char buffer[21];
       if (istart < 1)
 	{
-	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, istart);
-	  gfc_error ("Substring start index (%s) at %L below 1",
-		     buffer, &ref->u.ss.start->where);
+	  gfc_error ("Substring start index (%wd) at %L below 1",
+		     istart, &ref->u.ss.start->where);
 	  return false;
 	}
 
@@ -4568,9 +4566,8 @@ substring_has_constant_len (gfc_expr *e)
 	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
       if (iend > length)
 	{
-	  sprintf (buffer, HOST_WIDE_INT_PRINT_DEC, iend);
-	  gfc_error ("Substring end index (%s) at %L exceeds string length",
-		     buffer, &ref->u.ss.end->where);
+	  gfc_error ("Substring end index (%wd) at %L exceeds string length",
+		     iend, &ref->u.ss.end->where);
 	  return false;
 	}
       length = iend - istart + 1;
-- 
cgit v1.1


From 7c9e1645836d7746838acebb7018b1774490ab5c Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 21 Aug 2021 00:16:29 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8bf8cde..7da56e7 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,51 @@
+2021-08-20  Tobias Burnus  <tobias@codesourcery.com>
+
+	* error.c
+	(error_uinteger): Take 'long long unsigned' instead
+	of 'long unsigned' as argumpent.
+	(error_integer): Take 'long long' instead of 'long'.
+	(error_hwuint, error_hwint): New.
+	(error_print): Update to handle 'll' and 'w'
+	length modifiers.
+	* simplify.c (substring_has_constant_len): Use '%wd'
+	in gfc_error.
+
+2021-08-20  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100950
+	* simplify.c (substring_has_constant_len): Fix format string of
+	gfc_error, pass HOST_WIDE_INT bounds values via char buffer.
+
+2021-08-20  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity'
+	and 'message' clauses.
+	(show_omp_node, show_code_node): Handle EXEC_OMP_ERROR.
+	* gfortran.h (gfc_statement): Add ST_OMP_ERROR.
+	(gfc_omp_severity_type, gfc_omp_at_type): New.
+	(gfc_omp_clauses): Add 'at', 'severity' and 'message' clause;
+	use more bitfields + ENUM_BITFIELD.
+	(gfc_exec_op): Add EXEC_OMP_ERROR.
+	* match.h (gfc_match_omp_error): New.
+	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE).
+	(gfc_match_omp_clauses): Handle new clauses.
+	(OMP_ERROR_CLAUSES, gfc_match_omp_error): New.
+	(resolve_omp_clauses): Resolve new clauses.
+	(omp_code_to_statement, gfc_resolve_omp_directive): Handle
+	EXEC_OMP_ERROR.
+	* parse.c (decode_omp_directive, next_statement,
+	gfc_ascii_statement): Handle 'omp error'.
+	* resolve.c (gfc_resolve_blocks): Likewise.
+	* st.c (gfc_free_statement): Likewise.
+	* trans-openmp.c (gfc_trans_omp_error): Likewise.
+	(gfc_trans_omp_directive): Likewise.
+	* trans.c (trans_code): Likewise.
+
+2021-08-20  Jakub Jelinek  <jakub@redhat.com>
+
+	* types.def (BT_FN_VOID_CONST_PTR_SIZE): New DEF_FUNCTION_TYPE_2.
+	* f95-lang.c (ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST): Define.
+
 2021-08-19  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/100950
-- 
cgit v1.1


From d4de7e32eff0a6363defa50b052d7a30548b6552 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 23 Aug 2021 15:13:30 +0200
Subject: Fortran/OpenMP: strict modifier on grainsize/num_tasks

This patch adds support for the 'strict' modifier on grainsize/num_tasks
clauses, an OpenMP 5.1 feature supported in C/C++ since commit
r12-3066-g3bc75533d1f87f0617be6c1af98804f9127ec637

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle 'strict' modifier
	on grainsize/num_tasks
	* gfortran.h (gfc_omp_clauses): Add grainsize_strict
	and num_tasks_strict.
	* trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses):
	Handle 'strict' modifier on grainsize/num_tasks.
	* openmp.c (gfc_match_omp_clauses): Likewise.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/taskloop-4-a.f90: New test.
	* testsuite/libgomp.fortran/taskloop-4.f90: New test.
	* testsuite/libgomp.fortran/taskloop-5-a.f90: New test.
	* testsuite/libgomp.fortran/taskloop-5.f90: New test.
---
 gcc/fortran/dump-parse-tree.c |  4 ++++
 gcc/fortran/gfortran.h        |  2 +-
 gcc/fortran/openmp.c          | 20 ++++++++++++++++----
 gcc/fortran/trans-openmp.c    |  8 ++++++++
 4 files changed, 29 insertions(+), 5 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index c75a0a9..a1df47c 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1805,6 +1805,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
   if (omp_clauses->grainsize)
     {
       fputs (" GRAINSIZE(", dumpfile);
+      if (omp_clauses->grainsize_strict)
+	fputs ("strict: ", dumpfile);
       show_expr (omp_clauses->grainsize);
       fputc (')', dumpfile);
     }
@@ -1823,6 +1825,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
   if (omp_clauses->num_tasks)
     {
       fputs (" NUM_TASKS(", dumpfile);
+      if (omp_clauses->num_tasks_strict)
+	fputs ("strict: ", dumpfile);
       show_expr (omp_clauses->num_tasks);
       fputc (')', dumpfile);
     }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4b26cb4..48cdcdf 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1490,7 +1490,7 @@ typedef struct gfc_omp_clauses
   unsigned inbranch:1, notinbranch:1, nogroup:1;
   unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1;
   unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1;
-  unsigned capture:1;
+  unsigned capture:1, grainsize_strict:1, num_tasks_strict:1;
   ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3;
   ENUM_BITFIELD (gfc_omp_device_type) device_type:2;
   ENUM_BITFIELD (gfc_omp_memorder) memorder:3;
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 2380866..1aae35a 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1839,8 +1839,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	    }
 	  if ((mask & OMP_CLAUSE_GRAINSIZE)
 	      && c->grainsize == NULL
-	      && gfc_match ("grainsize ( %e )", &c->grainsize) == MATCH_YES)
-	    continue;
+	      && gfc_match ("grainsize ( ") == MATCH_YES)
+	    {
+	      if (gfc_match ("strict : ") == MATCH_YES)
+		c->grainsize_strict = true;
+	      if (gfc_match (" %e )", &c->grainsize) != MATCH_YES)
+		goto error;
+	      continue;
+	    }
 	  break;
 	case 'h':
 	  if ((mask & OMP_CLAUSE_HINT)
@@ -2148,8 +2154,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	    continue;
 	  if ((mask & OMP_CLAUSE_NUM_TASKS)
 	      && c->num_tasks == NULL
-	      && gfc_match ("num_tasks ( %e )", &c->num_tasks) == MATCH_YES)
-	    continue;
+	      && gfc_match ("num_tasks ( ") == MATCH_YES)
+	    {
+	      if (gfc_match ("strict : ") == MATCH_YES)
+		c->num_tasks_strict = true;
+	      if (gfc_match (" %e )", &c->num_tasks) != MATCH_YES)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_NUM_TEAMS)
 	      && c->num_teams == NULL
 	      && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES)
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 91888f3..40d2fd2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3998,6 +3998,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_GRAINSIZE);
       OMP_CLAUSE_GRAINSIZE_EXPR (c) = grainsize;
+      if (clauses->grainsize_strict)
+	OMP_CLAUSE_GRAINSIZE_STRICT (c) = 1;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
@@ -4013,6 +4015,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TASKS);
       OMP_CLAUSE_NUM_TASKS_EXPR (c) = num_tasks;
+      if (clauses->num_tasks_strict)
+	OMP_CLAUSE_NUM_TASKS_STRICT (c) = 1;
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
@@ -5964,8 +5968,12 @@ gfc_split_omp_clauses (gfc_code *code,
 	    = code->ext.omp_clauses->nogroup;
 	  clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize
 	    = code->ext.omp_clauses->grainsize;
+	  clausesa[GFC_OMP_SPLIT_TASKLOOP].grainsize_strict
+	    = code->ext.omp_clauses->grainsize_strict;
 	  clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks
 	    = code->ext.omp_clauses->num_tasks;
+	  clausesa[GFC_OMP_SPLIT_TASKLOOP].num_tasks_strict
+	    = code->ext.omp_clauses->num_tasks_strict;
 	  clausesa[GFC_OMP_SPLIT_TASKLOOP].priority
 	    = code->ext.omp_clauses->priority;
 	  clausesa[GFC_OMP_SPLIT_TASKLOOP].final_expr
-- 
cgit v1.1


From 57a9e63c96fca56299d7a52f6712e2d9290c197e Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Mon, 23 Aug 2021 15:18:37 +0200
Subject: Fortran/OpenMP: Improve duplicate errors

gcc/fortran/ChangeLog:

	* openmp.c (gfc_match_dupl_check, gfc_match_dupl_memorder,
	gfc_match_dupl_atomic): New.
	(gfc_match_omp_clauses): Use them; remove duplicate
	'release'/'relaxed' clause matching; improve error dignostic
	for 'default'.

gcc/testsuite/ChangeLog:

	* gfortran.dg/goacc/asyncwait-1.f95: Update dg-error.
	* gfortran.dg/goacc/default-2.f: Update dg-error.
	* gfortran.dg/goacc/enter-exit-data.f95: Update dg-error.
	* gfortran.dg/goacc/if.f95: Update dg-error.
	* gfortran.dg/goacc/parallel-kernels-clauses.f95: Update dg-error.
	* gfortran.dg/goacc/routine-6.f90: Update dg-error.
	* gfortran.dg/goacc/sie.f95: Update dg-error.
	* gfortran.dg/goacc/update-if_present-2.f90: Update dg-error.
	* gfortran.dg/gomp/cancel-2.f90: Update dg-error.
	* gfortran.dg/gomp/declare-simd-1.f90: Update dg-error.
	* gfortran.dg/gomp/error-3.f90: Update dg-error.
	* gfortran.dg/gomp/loop-2.f90: Update dg-error.
	* gfortran.dg/gomp/masked-2.f90: Update dg-error.
---
 gcc/fortran/openmp.c | 627 +++++++++++++++++++++++++++++++++------------------
 1 file changed, 403 insertions(+), 224 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1aae35a..715fd32 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1289,6 +1289,64 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
   return MATCH_YES;
 }
 
+
+/* Match with duplicate check. Matches 'name'. If expr != NULL, it
+   then matches '(expr)', otherwise, if open_parens is true,
+   it matches a ' ( ' after 'name'.
+   dupl_message requires '%qs %L' - and is used by
+   gfc_match_dupl_memorder and gfc_match_dupl_atomic.  */
+
+static match
+gfc_match_dupl_check (bool not_dupl, const char *name, bool open_parens = false,
+		      gfc_expr **expr = NULL, const char *dupl_msg = NULL)
+{
+  match m;
+  locus old_loc = gfc_current_locus;
+  if ((m = gfc_match (name)) != MATCH_YES)
+    return m;
+  if (!not_dupl)
+    {
+      if (dupl_msg)
+	gfc_error (dupl_msg, name, &old_loc);
+      else
+	gfc_error ("Duplicated %qs clause at %L", name, &old_loc);
+      return MATCH_ERROR;
+    }
+  if (open_parens || expr)
+    {
+      if (gfc_match (" ( ") != MATCH_YES)
+	{
+	  gfc_error ("Expected %<(%> after %qs at %C", name);
+	  return MATCH_ERROR;
+	}
+      if (expr)
+	{
+	  if (gfc_match ("%e )", expr) != MATCH_YES)
+	    {
+	      gfc_error ("Invalid expression after %<%s(%> at %C", name);
+	      return MATCH_ERROR;
+	    }
+	}
+    }
+  return MATCH_YES;
+}
+
+static match
+gfc_match_dupl_memorder (bool not_dupl, const char *name)
+{
+  return gfc_match_dupl_check (not_dupl, name, false, NULL,
+			       "Duplicated memory-order clause: unexpected %s "
+			       "clause at %L");
+}
+
+static match
+gfc_match_dupl_atomic (bool not_dupl, const char *name)
+{
+  return gfc_match_dupl_check (not_dupl, name, false, NULL,
+			       "Duplicated atomic clause: unexpected %s "
+			       "clause at %L");
+}
+
 /* Match OpenMP and OpenACC directive clauses. MASK is a bitmask of
    clauses that are allowed for a particular directive.  */
 
@@ -1323,6 +1381,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
       gfc_omp_namelist **head;
       old_loc = gfc_current_locus;
       char pc = gfc_peek_ascii_char ();
+      match m;
       switch (pc)
 	{
 	case 'a':
@@ -1352,17 +1411,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_MEMORDER)
-	      && c->memorder == OMP_MEMORDER_UNSET
-	      && gfc_match ("acq_rel") == MATCH_YES)
+	      && (m = gfc_match_dupl_memorder ((c->memorder
+						== OMP_MEMORDER_UNSET),
+					       "acq_rel")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->memorder = OMP_MEMORDER_ACQ_REL;
 	      needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_MEMORDER)
-	      && c->memorder == OMP_MEMORDER_UNSET
-	      && gfc_match ("acquire") == MATCH_YES)
+	      && (m = gfc_match_dupl_memorder ((c->memorder
+						== OMP_MEMORDER_UNSET),
+					       "acquire")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->memorder = OMP_MEMORDER_ACQUIRE;
 	      needs_space = true;
 	      continue;
@@ -1371,7 +1436,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      && gfc_match ("affinity ( ") == MATCH_YES)
 	    {
 	      gfc_namespace *ns_iter = NULL, *ns_curr = gfc_current_ns;
-	      match m = gfc_match_iterator (&ns_iter, true);
+	      m = gfc_match_iterator (&ns_iter, true);
 	      if (m == MATCH_ERROR)
 		break;
 	      if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
@@ -1398,9 +1463,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_AT)
-	      && c->at == OMP_AT_UNSET
-	      && gfc_match ("at ( ") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      if (gfc_match ("compilation )") == MATCH_YES)
 		c->at = OMP_AT_COMPILATION;
 	      else if (gfc_match ("execution )") == MATCH_YES)
@@ -1414,11 +1481,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_ASYNC)
-	      && !c->async
-	      && gfc_match ("async") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->async, "async")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->async = true;
-	      match m = gfc_match (" ( %e )", &c->async_expr);
+	      m = gfc_match (" ( %e )", &c->async_expr);
 	      if (m == MATCH_ERROR)
 		{
 		  gfc_current_locus = old_loc;
@@ -1436,9 +1504,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_AUTO)
-	      && !c->par_auto
-	      && gfc_match ("auto") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->par_auto, "auto"))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->par_auto = true;
 	      needs_space = true;
 	      continue;
@@ -1452,9 +1522,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  break;
 	case 'b':
 	  if ((mask & OMP_CLAUSE_BIND)
-	      && c->bind == OMP_BIND_UNSET
-	      && gfc_match ("bind ( ") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (c->bind == OMP_BIND_UNSET, "bind",
+					    true)) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      if (gfc_match ("teams )") == MATCH_YES)
 		c->bind = OMP_BIND_TEAMS;
 	      else if (gfc_match ("parallel )") == MATCH_YES)
@@ -1472,34 +1544,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  break;
 	case 'c':
 	  if ((mask & OMP_CLAUSE_CAPTURE)
-	      && !c->capture
-	      && gfc_match ("capture") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->capture, "capture"))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->capture = true;
 	      needs_space = true;
 	      continue;
 	    }
-	  if ((mask & OMP_CLAUSE_COLLAPSE)
-	      && !c->collapse)
+	  if (mask & OMP_CLAUSE_COLLAPSE)
 	    {
 	      gfc_expr *cexpr = NULL;
-	      match m = gfc_match ("collapse ( %e )", &cexpr);
-
-	      if (m == MATCH_YES)
-		{
-		  int collapse;
-		  if (gfc_extract_int (cexpr, &collapse, -1))
+	      if ((m = gfc_match_dupl_check (!c->collapse, "collapse", true,
+					     &cexpr)) != MATCH_NO)
+	      {
+		int collapse;
+		if (m == MATCH_ERROR)
+		  goto error;
+		if (gfc_extract_int (cexpr, &collapse, -1))
+		  collapse = 1;
+		else if (collapse <= 0)
+		  {
+		    gfc_error_now ("COLLAPSE clause argument not constant "
+				   "positive integer at %C");
 		    collapse = 1;
-		  else if (collapse <= 0)
-		    {
-		      gfc_error_now ("COLLAPSE clause argument not"
-				     " constant positive integer at %C");
-		      collapse = 1;
-		    }
-		  c->collapse = collapse;
-		  gfc_free_expr (cexpr);
-		  continue;
-		}
+		  }
+		gfc_free_expr (cexpr);
+		c->collapse = collapse;
+		continue;
+	      }
 	    }
 	  if ((mask & OMP_CLAUSE_COPY)
 	      && gfc_match ("copy ( ") == MATCH_YES
@@ -1539,28 +1613,6 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	    continue;
 	  break;
 	case 'd':
-	  if ((mask & OMP_CLAUSE_DEFAULT)
-	      && c->default_sharing == OMP_DEFAULT_UNKNOWN)
-	    {
-	      if (gfc_match ("default ( none )") == MATCH_YES)
-		c->default_sharing = OMP_DEFAULT_NONE;
-	      else if (openacc)
-		{
-		  if (gfc_match ("default ( present )") == MATCH_YES)
-		    c->default_sharing = OMP_DEFAULT_PRESENT;
-		}
-	      else
-		{
-		  if (gfc_match ("default ( firstprivate )") == MATCH_YES)
-		    c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
-		  else if (gfc_match ("default ( private )") == MATCH_YES)
-		    c->default_sharing = OMP_DEFAULT_PRIVATE;
-		  else if (gfc_match ("default ( shared )") == MATCH_YES)
-		    c->default_sharing = OMP_DEFAULT_SHARED;
-		}
-	      if (c->default_sharing != OMP_DEFAULT_UNKNOWN)
-		continue;
-	    }
 	  if ((mask & OMP_CLAUSE_DEFAULTMAP)
 	      && gfc_match ("defaultmap ( ") == MATCH_YES)
 	    {
@@ -1645,6 +1697,43 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		break;
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_DEFAULT)
+	      && (m = gfc_match_dupl_check (c->default_sharing
+					    == OMP_DEFAULT_UNKNOWN, "default",
+					    true)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (gfc_match ("none") == MATCH_YES)
+		c->default_sharing = OMP_DEFAULT_NONE;
+	      else if (openacc)
+		{
+		  if (gfc_match ("present") == MATCH_YES)
+		    c->default_sharing = OMP_DEFAULT_PRESENT;
+		}
+	      else
+		{
+		  if (gfc_match ("firstprivate") == MATCH_YES)
+		    c->default_sharing = OMP_DEFAULT_FIRSTPRIVATE;
+		  else if (gfc_match ("private") == MATCH_YES)
+		    c->default_sharing = OMP_DEFAULT_PRIVATE;
+		  else if (gfc_match ("shared") == MATCH_YES)
+		    c->default_sharing = OMP_DEFAULT_SHARED;
+		}
+	      if (c->default_sharing == OMP_DEFAULT_UNKNOWN)
+		{
+		  if (openacc)
+		    gfc_error ("Expected NONE or PRESENT in DEFAULT clause "
+			       "at %C");
+		  else
+		    gfc_error ("Expected NONE, FIRSTPRIVATE, PRIVATE or SHARED "
+			       "in DEFAULT clause at %C");
+		  goto error;
+		}
+	      if (gfc_match (" )") != MATCH_YES)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_DELETE)
 	      && gfc_match ("delete ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -1660,7 +1749,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		break;
 	      if (m_it == MATCH_YES && gfc_match (" , ") != MATCH_YES)
 		break;
-	      match m = MATCH_YES;
+	      m = MATCH_YES;
 	      gfc_omp_depend_op depend_op = OMP_DEPEND_OUT;
 	      if (gfc_match ("inout") == MATCH_YES)
 		depend_op = OMP_DEPEND_INOUT;
@@ -1736,9 +1825,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	    continue;
 	  if ((mask & OMP_CLAUSE_DEVICE)
 	      && !openacc
-	      && c->device == NULL
-	      && gfc_match ("device ( %e )", &c->device) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->device, "device", true,
+					    &c->device)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_DEVICE)
 	      && openacc
 	      && gfc_match ("device ( ") == MATCH_YES
@@ -1779,7 +1872,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      && c->dist_sched_kind == OMP_SCHED_NONE
 	      && gfc_match ("dist_schedule ( static") == MATCH_YES)
 	    {
-	      match m = MATCH_NO;
+	      m = MATCH_NO;
 	      c->dist_sched_kind = OMP_SCHED_STATIC;
 	      m = gfc_match (" , %e )", &c->dist_chunk_size);
 	      if (m != MATCH_YES)
@@ -1795,17 +1888,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  break;
 	case 'f':
 	  if ((mask & OMP_CLAUSE_FILTER)
-	      && c->filter == NULL
-	      && gfc_match ("filter ( %e )", &c->filter) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->filter, "filter", true,
+					    &c->filter)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_FINAL)
-	      && c->final_expr == NULL
-	      && gfc_match ("final ( %e )", &c->final_expr) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->final_expr, "final", true,
+					    &c->final_expr)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_FINALIZE)
-	      && !c->finalize
-	      && gfc_match ("finalize") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->finalize, "finalize"))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->finalize = true;
 	      needs_space = true;
 	      continue;
@@ -1823,11 +1926,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  break;
 	case 'g':
 	  if ((mask & OMP_CLAUSE_GANG)
-	      && !c->gang
-	      && gfc_match ("gang") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->gang, "gang")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->gang = true;
-	      match m = match_oacc_clause_gwv (c, GOMP_DIM_GANG);
+	      m = match_oacc_clause_gwv (c, GOMP_DIM_GANG);
 	      if (m == MATCH_ERROR)
 		{
 		  gfc_current_locus = old_loc;
@@ -1838,9 +1942,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_GRAINSIZE)
-	      && c->grainsize == NULL
-	      && gfc_match ("grainsize ( ") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->grainsize, "grainsize", true))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      if (gfc_match ("strict : ") == MATCH_YES)
 		c->grainsize_strict = true;
 	      if (gfc_match (" %e )", &c->grainsize) != MATCH_YES)
@@ -1850,9 +1956,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  break;
 	case 'h':
 	  if ((mask & OMP_CLAUSE_HINT)
-	      && c->hint == NULL
-	      && gfc_match ("hint ( %e )", &c->hint) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->hint, "hint", true, &c->hint))
+		 != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_HOST_SELF)
 	      && gfc_match ("host ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -1861,24 +1971,36 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	    continue;
 	  break;
 	case 'i':
+	  if ((mask & OMP_CLAUSE_IF_PRESENT)
+	      && (m = gfc_match_dupl_check (!c->if_present, "if_present"))
+		 != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      c->if_present = true;
+	      needs_space = true;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_IF)
-	      && c->if_expr == NULL
-	      && gfc_match ("if ( ") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->if_expr, "if", true))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      if (!openacc)
 		{
 		  /* This should match the enum gfc_omp_if_kind order.  */
 		  static const char *ifs[OMP_IF_LAST] = {
-		    " cancel : %e )",
-		    " parallel : %e )",
-		    " simd : %e )",
-		    " task : %e )",
-		    " taskloop : %e )",
-		    " target : %e )",
-		    " target data : %e )",
-		    " target update : %e )",
-		    " target enter data : %e )",
-		    " target exit data : %e )" };
+		    "cancel : %e )",
+		    "parallel : %e )",
+		    "simd : %e )",
+		    "task : %e )",
+		    "taskloop : %e )",
+		    "target : %e )",
+		    "target data : %e )",
+		    "target update : %e )",
+		    "target enter data : %e )",
+		    "target exit data : %e )" };
 		  int i;
 		  for (i = 0; i < OMP_IF_LAST; i++)
 		    if (c->if_exprs[i] == NULL
@@ -1887,34 +2009,29 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		  if (i < OMP_IF_LAST)
 		    continue;
 		}
-	      if (gfc_match ("%e )", &c->if_expr) == MATCH_YES)
+	      if (gfc_match (" %e )", &c->if_expr) == MATCH_YES)
 		continue;
-	      gfc_current_locus = old_loc;
-	    }
-	  if ((mask & OMP_CLAUSE_IF_PRESENT)
-	      && !c->if_present
-	      && gfc_match ("if_present") == MATCH_YES)
-	    {
-	      c->if_present = true;
-	      needs_space = true;
-	      continue;
+	      goto error;
 	    }
 	  if ((mask & OMP_CLAUSE_IN_REDUCTION)
 	      && gfc_match_omp_clause_reduction (pc, c, openacc,
 						 allow_derived) == MATCH_YES)
 	    continue;
 	  if ((mask & OMP_CLAUSE_INBRANCH)
-	      && !c->inbranch
-	      && !c->notinbranch
-	      && gfc_match ("inbranch") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->inbranch && !c->notinbranch,
+					    "inbranch")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->inbranch = needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_INDEPENDENT)
-	      && !c->independent
-	      && gfc_match ("independent") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->independent, "independent"))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->independent = true;
 	      needs_space = true;
 	      continue;
@@ -2095,16 +2212,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      gfc_current_locus = old_loc;
 	      break;
 	    }
-	  if ((mask & OMP_CLAUSE_MERGEABLE) && !c->mergeable
-	      && gfc_match ("mergeable") == MATCH_YES)
+	  if ((mask & OMP_CLAUSE_MERGEABLE)
+	      && (m = gfc_match_dupl_check (!c->mergeable, "mergeable"))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->mergeable = needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_MESSAGE)
-	      && !c->message
-	      && gfc_match ("message ( %e )", &c->message) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->message, "message", true,
+		 &c->message)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  break;
 	case 'n':
 	  if ((mask & OMP_CLAUSE_NO_CREATE)
@@ -2114,16 +2238,19 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					   allow_derived))
 	    continue;
 	  if ((mask & OMP_CLAUSE_NOGROUP)
-	      && !c->nogroup
-	      && gfc_match ("nogroup") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->nogroup, "nogroup"))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->nogroup = needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_NOHOST)
-	      && !c->nohost
-	      && gfc_match ("nohost") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->nohost, "nohost")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->nohost = needs_space = true;
 	      continue;
 	    }
@@ -2133,29 +2260,38 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					      true) == MATCH_YES)
 	    continue;
 	  if ((mask & OMP_CLAUSE_NOTINBRANCH)
-	      && !c->notinbranch
-	      && !c->inbranch
-	      && gfc_match ("notinbranch") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->notinbranch && !c->inbranch,
+					    "notinbranch")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->notinbranch = needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_NOWAIT)
-	      && !c->nowait
-	      && gfc_match ("nowait") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->nowait, "nowait")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->nowait = needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_NUM_GANGS)
-	      && c->num_gangs_expr == NULL
-	      && gfc_match ("num_gangs ( %e )",
-			    &c->num_gangs_expr) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->num_gangs_expr, "num_gangs",
+					    true)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (gfc_match (" %e )", &c->num_gangs_expr) != MATCH_YES)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_NUM_TASKS)
-	      && c->num_tasks == NULL
-	      && gfc_match ("num_tasks ( ") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->num_tasks, "num_tasks", true))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      if (gfc_match ("strict : ") == MATCH_YES)
 		c->num_tasks_strict = true;
 	      if (gfc_match (" %e )", &c->num_tasks) != MATCH_YES)
@@ -2163,19 +2299,30 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_NUM_TEAMS)
-	      && c->num_teams == NULL
-	      && gfc_match ("num_teams ( %e )", &c->num_teams) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->num_teams, "num_teams", true,
+					    &c->num_teams)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_NUM_THREADS)
-	      && c->num_threads == NULL
-	      && (gfc_match ("num_threads ( %e )", &c->num_threads)
-		  == MATCH_YES))
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->num_threads, "num_threads", true,
+					    &c->num_threads)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_NUM_WORKERS)
-	      && c->num_workers_expr == NULL
-	      && gfc_match ("num_workers ( %e )",
-			    &c->num_workers_expr) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->num_workers_expr, "num_workers",
+					    true, &c->num_workers_expr))
+		 != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  break;
 	case 'o':
 	  if ((mask & OMP_CLAUSE_ORDER)
@@ -2186,11 +2333,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_ORDERED)
-	      && !c->ordered
-	      && gfc_match ("ordered") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->ordered, "ordered"))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      gfc_expr *cexpr = NULL;
-	      match m = gfc_match (" ( %e )", &cexpr);
+	      m = gfc_match (" ( %e )", &cexpr);
 
 	      c->ordered = true;
 	      if (m == MATCH_YES)
@@ -2262,35 +2411,46 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					   OMP_MAP_ALLOC, true, allow_derived))
 	    continue;
 	  if ((mask & OMP_CLAUSE_PRIORITY)
-	      && c->priority == NULL
-	      && gfc_match ("priority ( %e )", &c->priority) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->priority, "priority", true,
+					    &c->priority)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_PRIVATE)
 	      && gfc_match_omp_variable_list ("private (",
 					      &c->lists[OMP_LIST_PRIVATE],
 					      true) == MATCH_YES)
 	    continue;
 	  if ((mask & OMP_CLAUSE_PROC_BIND)
-	      && c->proc_bind == OMP_PROC_BIND_UNKNOWN)
+	      && (m = gfc_match_dupl_check ((c->proc_bind
+					     == OMP_PROC_BIND_UNKNOWN),
+					    "proc_bind", true)) != MATCH_NO)
 	    {
-	      /* Primary is new and master is deprecated in OpenMP 5.1.  */
-	      if (gfc_match ("proc_bind ( primary )") == MATCH_YES)
-		c->proc_bind = OMP_PROC_BIND_MASTER;
-	      else if (gfc_match ("proc_bind ( master )") == MATCH_YES)
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (gfc_match ("primary )") == MATCH_YES)
+		c->proc_bind = OMP_PROC_BIND_PRIMARY;
+	      else if (gfc_match ("master )") == MATCH_YES)
 		c->proc_bind = OMP_PROC_BIND_MASTER;
-	      else if (gfc_match ("proc_bind ( spread )") == MATCH_YES)
+	      else if (gfc_match ("spread )") == MATCH_YES)
 		c->proc_bind = OMP_PROC_BIND_SPREAD;
-	      else if (gfc_match ("proc_bind ( close )") == MATCH_YES)
+	      else if (gfc_match ("close )") == MATCH_YES)
 		c->proc_bind = OMP_PROC_BIND_CLOSE;
-	      if (c->proc_bind != OMP_PROC_BIND_UNKNOWN)
-		continue;
+	      else
+		goto error;
+	      continue;
 	    }
 	  break;
 	case 'r':
 	  if ((mask & OMP_CLAUSE_ATOMIC)
-	      && c->atomic_op == GFC_OMP_ATOMIC_UNSET
-	      && gfc_match ("read") == MATCH_YES)
+	      && (m = gfc_match_dupl_atomic ((c->atomic_op
+					      == GFC_OMP_ATOMIC_UNSET),
+					     "read")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->atomic_op = GFC_OMP_ATOMIC_READ;
 	      needs_space = true;
 	      continue;
@@ -2300,33 +2460,23 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 						 allow_derived) == MATCH_YES)
 	    continue;
 	  if ((mask & OMP_CLAUSE_MEMORDER)
-	      && c->memorder == OMP_MEMORDER_UNSET
-	      && gfc_match ("relaxed") == MATCH_YES)
-	    {
-	      c->memorder = OMP_MEMORDER_RELAXED;
-	      needs_space = true;
-	      continue;
-	    }
-	  if ((mask & OMP_CLAUSE_MEMORDER)
-	      && c->memorder == OMP_MEMORDER_UNSET
-	      && gfc_match ("release") == MATCH_YES)
-	    {
-	      c->memorder = OMP_MEMORDER_RELEASE;
-	      needs_space = true;
-	      continue;
-	    }
-	  if ((mask & OMP_CLAUSE_MEMORDER)
-	      && c->memorder == OMP_MEMORDER_UNSET
-	      && gfc_match ("relaxed") == MATCH_YES)
+	      && (m = gfc_match_dupl_memorder ((c->memorder
+						== OMP_MEMORDER_UNSET),
+					       "relaxed")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->memorder = OMP_MEMORDER_RELAXED;
 	      needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_MEMORDER)
-	      && c->memorder == OMP_MEMORDER_UNSET
-	      && gfc_match ("release") == MATCH_YES)
+	      && (m = gfc_match_dupl_memorder ((c->memorder
+						== OMP_MEMORDER_UNSET),
+					       "release")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->memorder = OMP_MEMORDER_RELEASE;
 	      needs_space = true;
 	      continue;
@@ -2334,13 +2484,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  break;
 	case 's':
 	  if ((mask & OMP_CLAUSE_SAFELEN)
-	      && c->safelen_expr == NULL
-	      && gfc_match ("safelen ( %e )", &c->safelen_expr) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->safelen_expr, "safelen",
+					    true, &c->safelen_expr))
+		 != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_SCHEDULE)
-	      && c->sched_kind == OMP_SCHED_NONE
-	      && gfc_match ("schedule ( ") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (c->sched_kind == OMP_SCHED_NONE,
+					    "schedule", true)) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      int nmodifiers = 0;
 	      locus old_loc2 = gfc_current_locus;
 	      do
@@ -2387,7 +2544,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		c->sched_kind = OMP_SCHED_AUTO;
 	      if (c->sched_kind != OMP_SCHED_NONE)
 		{
-		  match m = MATCH_NO;
+		  m = MATCH_NO;
 		  if (c->sched_kind != OMP_SCHED_RUNTIME
 		      && c->sched_kind != OMP_SCHED_AUTO)
 		    m = gfc_match (" , %e )", &c->chunk_size);
@@ -2408,17 +2565,21 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					   allow_derived))
 	    continue;
 	  if ((mask & OMP_CLAUSE_SEQ)
-	      && !c->seq
-	      && gfc_match ("seq") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->seq, "seq")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->seq = true;
 	      needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_MEMORDER)
-	      && c->memorder == OMP_MEMORDER_UNSET
-	      && gfc_match ("seq_cst") == MATCH_YES)
+	      && (m = gfc_match_dupl_memorder ((c->memorder
+						== OMP_MEMORDER_UNSET),
+					       "seq_cst")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->memorder = OMP_MEMORDER_SEQ_CST;
 	      needs_space = true;
 	      continue;
@@ -2429,20 +2590,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					      true) == MATCH_YES)
 	    continue;
 	  if ((mask & OMP_CLAUSE_SIMDLEN)
-	      && c->simdlen_expr == NULL
-	      && gfc_match ("simdlen ( %e )", &c->simdlen_expr) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->simdlen_expr, "simdlen", true,
+					    &c->simdlen_expr)) != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_SIMD)
-	      && !c->simd
-	      && gfc_match ("simd") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->simd, "simd")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->simd = needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_SEVERITY)
-	      && c->severity == OMP_SEVERITY_UNSET
-	      && gfc_match ("severity ( ") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->severity, "severity", true))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      if (gfc_match ("fatal )") == MATCH_YES)
 		c->severity = OMP_SEVERITY_FATAL;
 	      else if (gfc_match ("warning )") == MATCH_YES)
@@ -2462,14 +2630,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 						 allow_derived) == MATCH_YES)
 	    continue;
 	  if ((mask & OMP_CLAUSE_THREAD_LIMIT)
-	      && c->thread_limit == NULL
-	      && gfc_match ("thread_limit ( %e )",
-			    &c->thread_limit) == MATCH_YES)
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->thread_limit, "thread_limit",
+					    true, &c->thread_limit))
+		 != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_THREADS)
-	      && !c->threads
-	      && gfc_match ("threads") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->threads, "threads"))
+		 != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->threads = needs_space = true;
 	      continue;
 	    }
@@ -2497,16 +2671,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					      false) == MATCH_YES)
 	    continue;
 	  if ((mask & OMP_CLAUSE_UNTIED)
-	      && !c->untied
-	      && gfc_match ("untied") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->untied, "untied")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->untied = needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_ATOMIC)
-	      && c->atomic_op == GFC_OMP_ATOMIC_UNSET
-	      && gfc_match ("update") == MATCH_YES)
+	      && (m = gfc_match_dupl_atomic ((c->atomic_op
+					      == GFC_OMP_ATOMIC_UNSET),
+					     "update")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->atomic_op = GFC_OMP_ATOMIC_UPDATE;
 	      needs_space = true;
 	      continue;
@@ -2531,21 +2709,24 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  /* VECTOR_LENGTH must be matched before VECTOR, because the latter
 	     doesn't unconditionally match '('.  */
 	  if ((mask & OMP_CLAUSE_VECTOR_LENGTH)
-	      && c->vector_length_expr == NULL
-	      && (gfc_match ("vector_length ( %e )", &c->vector_length_expr)
-		  == MATCH_YES))
-	    continue;
+	      && (m = gfc_match_dupl_check (!c->vector_length_expr,
+					    "vector_length", true,
+					    &c->vector_length_expr))
+		 != MATCH_NO)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_VECTOR)
-	      && !c->vector
-	      && gfc_match ("vector") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->vector, "vector")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->vector = true;
-	      match m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR);
+	      m = match_oacc_clause_gwv (c, GOMP_DIM_VECTOR);
 	      if (m == MATCH_ERROR)
-		{
-		  gfc_current_locus = old_loc;
-		  break;
-		}
+		goto error;
 	      if (m == MATCH_NO)
 		needs_space = true;
 	      continue;
@@ -2555,12 +2736,9 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	  if ((mask & OMP_CLAUSE_WAIT)
 	      && gfc_match ("wait") == MATCH_YES)
 	    {
-	      match m = match_oacc_expr_list (" (", &c->wait_list, false);
+	      m = match_oacc_expr_list (" (", &c->wait_list, false);
 	      if (m == MATCH_ERROR)
-		{
-		  gfc_current_locus = old_loc;
-		  break;
-		}
+		goto error;
 	      else if (m == MATCH_NO)
 		{
 		  gfc_expr *expr
@@ -2578,24 +2756,25 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_WORKER)
-	      && !c->worker
-	      && gfc_match ("worker") == MATCH_YES)
+	      && (m = gfc_match_dupl_check (!c->worker, "worker")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->worker = true;
-	      match m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER);
+	      m = match_oacc_clause_gwv (c, GOMP_DIM_WORKER);
 	      if (m == MATCH_ERROR)
-		{
-		  gfc_current_locus = old_loc;
-		  break;
-		}
+		goto error;
 	      else if (m == MATCH_NO)
 		needs_space = true;
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_ATOMIC)
-	      && c->atomic_op == GFC_OMP_ATOMIC_UNSET
-	      && gfc_match ("write") == MATCH_YES)
+	      && (m = gfc_match_dupl_atomic ((c->atomic_op
+					      == GFC_OMP_ATOMIC_UNSET),
+					     "write")) != MATCH_NO)
 	    {
+	      if (m == MATCH_ERROR)
+		goto error;
 	      c->atomic_op = GFC_OMP_ATOMIC_WRITE;
 	      needs_space = true;
 	      continue;
-- 
cgit v1.1


From 38b19c5b0805f9acfcf52430cebca025fc3cdea6 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 24 Aug 2021 00:17:00 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7da56e7..307886d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2021-08-23  Tobias Burnus  <tobias@codesourcery.com>
+
+	* openmp.c (gfc_match_dupl_check, gfc_match_dupl_memorder,
+	gfc_match_dupl_atomic): New.
+	(gfc_match_omp_clauses): Use them; remove duplicate
+	'release'/'relaxed' clause matching; improve error dignostic
+	for 'default'.
+
+2021-08-23  Tobias Burnus  <tobias@codesourcery.com>
+
+	* dump-parse-tree.c (show_omp_clauses): Handle 'strict' modifier
+	on grainsize/num_tasks
+	* gfortran.h (gfc_omp_clauses): Add grainsize_strict
+	and num_tasks_strict.
+	* trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses):
+	Handle 'strict' modifier on grainsize/num_tasks.
+	* openmp.c (gfc_match_omp_clauses): Likewise.
+
 2021-08-20  Tobias Burnus  <tobias@codesourcery.com>
 
 	* error.c
-- 
cgit v1.1


From f95946afd160e2a1f4beac4ee5e6d5633307f39a Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 24 Aug 2021 21:07:50 +0200
Subject: Fortran: fix pointless warning for static variables

gcc/fortran/ChangeLog:

	PR fortran/98411
	* trans-decl.c (gfc_finish_var_decl): Adjust check to handle
	implicit SAVE as well as variables in the main program.  Improve
	warning message text.

gcc/testsuite/ChangeLog:

	PR fortran/98411
	* gfortran.dg/pr98411.f90: Adjust testcase options to restrict to
	F2008, and verify case of implicit SAVE.
---
 gcc/fortran/trans-decl.c | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 784f7b6..bed61e2 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -743,8 +743,10 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
 
   /* Keep variables larger than max-stack-var-size off stack.  */
   if (!(sym->ns->proc_name && sym->ns->proc_name->attr.recursive)
+      && !(sym->ns->proc_name && sym->ns->proc_name->attr.is_main_program)
       && !sym->attr.automatic
       && sym->attr.save != SAVE_EXPLICIT
+      && sym->attr.save != SAVE_IMPLICIT
       && INTEGER_CST_P (DECL_SIZE_UNIT (decl))
       && !gfc_can_put_var_on_stack (DECL_SIZE_UNIT (decl))
 	 /* Put variable length auto array pointers always into stack.  */
@@ -757,13 +759,17 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
     {
       if (flag_max_stack_var_size > 0)
 	gfc_warning (OPT_Wsurprising,
-		     "Array %qs at %L is larger than limit set by"
-		     " %<-fmax-stack-var-size=%>, moved from stack to static"
-		     " storage. This makes the procedure unsafe when called"
-		     " recursively, or concurrently from multiple threads."
-		     " Consider using %<-frecursive%>, or increase the"
-		     " %<-fmax-stack-var-size=%> limit, or change the code to"
-		     " use an ALLOCATABLE array.",
+		     "Array %qs at %L is larger than limit set by "
+		     "%<-fmax-stack-var-size=%>, moved from stack to static "
+		     "storage. This makes the procedure unsafe when called "
+		     "recursively, or concurrently from multiple threads. "
+		     "Consider increasing the %<-fmax-stack-var-size=%> "
+		     "limit (or use %<-frecursive%>, which implies "
+		     "unlimited %<-fmax-stack-var-size%>) - or change the "
+		     "code to use an ALLOCATABLE array. If the variable is "
+		     "never accessed concurrently, this warning can be "
+		     "ignored, and the variable could also be declared with "
+		     "the SAVE attribute.",
 		     sym->name, &sym->declared_at);
 
       TREE_STATIC (decl) = 1;
-- 
cgit v1.1


From 05ace2946b4369b49026789d5a83635076b10422 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 25 Aug 2021 00:16:57 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 307886d..2866f5d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-08-24  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/98411
+	* trans-decl.c (gfc_finish_var_decl): Adjust check to handle
+	implicit SAVE as well as variables in the main program.  Improve
+	warning message text.
+
 2021-08-23  Tobias Burnus  <tobias@codesourcery.com>
 
 	* openmp.c (gfc_match_dupl_check, gfc_match_dupl_memorder,
-- 
cgit v1.1


From 3ac6b5cff1eca4e1748c671960ef7b4ca5e47fd2 Mon Sep 17 00:00:00 2001
From: Lewis Hyatt <lhyatt@gmail.com>
Date: Tue, 24 Aug 2021 19:30:44 -0400
Subject: diagnostics: Support for -finput-charset [PR93067]

Adds the logic to handle -finput-charset in layout_get_source_line(), so that
source lines are converted from their input encodings prior to being output by
diagnostics machinery. Also adds the ability to strip a UTF-8 BOM similarly.

gcc/c-family/ChangeLog:

	PR other/93067
	* c-opts.c (c_common_input_charset_cb): New function.
	(c_common_post_options): Call new function
	diagnostic_initialize_input_context().

gcc/d/ChangeLog:

	PR other/93067
	* d-lang.cc (d_input_charset_callback): New function.
	(d_init): Call new function
	diagnostic_initialize_input_context().

gcc/fortran/ChangeLog:

	PR other/93067
	* cpp.c (gfc_cpp_post_options): Call new function
	diagnostic_initialize_input_context().

gcc/ChangeLog:

	PR other/93067
	* coretypes.h (typedef diagnostic_input_charset_callback): Declare.
	* diagnostic.c (diagnostic_initialize_input_context): New function.
	* diagnostic.h (diagnostic_initialize_input_context): Declare.
	* input.c (default_charset_callback): New function.
	(file_cache::initialize_input_context): New function.
	(file_cache_slot::create): Added ability to convert the input
	according to the input context.
	(file_cache::file_cache): Initialize the new input context.
	(class file_cache_slot): Added new m_alloc_offset member.
	(file_cache_slot::file_cache_slot): Initialize the new member.
	(file_cache_slot::~file_cache_slot): Handle potentially offset buffer.
	(file_cache_slot::maybe_grow): Likewise.
	(file_cache_slot::needs_read_p): Handle NULL fp, which is now possible.
	(file_cache_slot::get_next_line): Likewise.
	* input.h (class file_cache): Added input context member.

libcpp/ChangeLog:

	PR other/93067
	* charset.c (init_iconv_desc): Adapt to permit PFILE argument to
	be NULL.
	(_cpp_convert_input): Likewise. Also move UTF-8 BOM logic to...
	(cpp_check_utf8_bom): ...here.  New function.
	(cpp_input_conversion_is_trivial): New function.
	* files.c (read_file_guts): Allow PFILE argument to be NULL.  Add
	INPUT_CHARSET argument as an alternate source of this information.
	(read_file): Pass the new argument to read_file_guts.
	(cpp_get_converted_source): New function.
	* include/cpplib.h (struct cpp_converted_source): Declare.
	(cpp_get_converted_source): Declare.
	(cpp_input_conversion_is_trivial): Declare.
	(cpp_check_utf8_bom): Declare.

gcc/testsuite/ChangeLog:

	PR other/93067
	* gcc.dg/diagnostic-input-charset-1.c: New test.
	* gcc.dg/diagnostic-input-utf8-bom.c: New test.
---
 gcc/fortran/cpp.c | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.c
index 419cd6a..83c4517 100644
--- a/gcc/fortran/cpp.c
+++ b/gcc/fortran/cpp.c
@@ -493,6 +493,12 @@ gfc_cpp_post_options (void)
 
   cpp_post_options (cpp_in);
 
+
+  /* Let diagnostics infrastructure know how to convert input files the same
+     way libcpp will do it, namely, with no charset conversion but with
+     skipping of a UTF-8 BOM if present.  */
+  diagnostic_initialize_input_context (global_dc, nullptr, true);
+
   gfc_cpp_register_include_paths ();
 }
 
-- 
cgit v1.1


From 85d77ac4745c6263520c8fe66c0dfced8404003f Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 26 Aug 2021 00:17:03 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2866f5d..9679f35 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-08-25  Lewis Hyatt  <lhyatt@gmail.com>
+
+	PR other/93067
+	* cpp.c (gfc_cpp_post_options): Call new function
+	diagnostic_initialize_input_context().
+
 2021-08-24  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/98411
-- 
cgit v1.1


From f9809ef57005409ee658294d6e8dad9ee8897e88 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 28 Aug 2021 20:09:44 +0200
Subject: Fortran - reject function entries with mismatched characteristics

gcc/fortran/ChangeLog:

	PR fortran/87737
	* resolve.c (resolve_entries): For functions of type CHARACTER
	tighten the checks for matching characteristics.

gcc/testsuite/ChangeLog:

	PR fortran/87737
	* gfortran.dg/entry_24.f90: New test.
---
 gcc/fortran/resolve.c | 9 +++++++++
 1 file changed, 9 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 5b9ba43..f641d0d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -804,6 +804,15 @@ resolve_entries (gfc_namespace *ns)
 	     the same string length, i.e. both len=*, or both len=4.
 	     Having both len=<variable> is also possible, but difficult to
 	     check at compile time.  */
+	  else if (ts->type == BT_CHARACTER
+		   && (el->sym->result->attr.allocatable
+		       != ns->entries->sym->result->attr.allocatable))
+	    {
+	      gfc_error ("Function %s at %L has entry %s with mismatched "
+			 "characteristics", ns->entries->sym->name,
+			 &ns->entries->sym->declared_at, el->sym->name);
+	      return;
+	    }
 	  else if (ts->type == BT_CHARACTER && ts->u.cl && fts->u.cl
 		   && (((ts->u.cl->length && !fts->u.cl->length)
 			||(!ts->u.cl->length && fts->u.cl->length))
-- 
cgit v1.1


From a21e5de4214705632fed99993dcabe1c12e9c548 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sun, 29 Aug 2021 00:16:41 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9679f35..cfda885 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-08-28  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/87737
+	* resolve.c (resolve_entries): For functions of type CHARACTER
+	tighten the checks for matching characteristics.
+
 2021-08-25  Lewis Hyatt  <lhyatt@gmail.com>
 
 	PR other/93067
-- 
cgit v1.1


From 9213ff13247739d6d335064a6b568278a872a991 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 30 Aug 2021 22:41:01 +0200
Subject: Fortran - correct check for constraint F2008:C628 / F2018:C932

gcc/fortran/ChangeLog:

	PR fortran/101349
	* resolve.c (resolve_allocate_expr): An unlimited polymorphic
	argument to ALLOCATE must be ALLOCATABLE or a POINTER.  Fix the
	corresponding check.

gcc/testsuite/ChangeLog:

	PR fortran/101349
	* gfortran.dg/unlimited_polymorphic_33.f90: New test.
---
 gcc/fortran/resolve.c | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f641d0d..d7aa286 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7829,8 +7829,9 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code, bool *array_alloc_wo_spec)
 	}
     }
 
-  /* Check for F08:C628.  */
-  if (allocatable == 0 && pointer == 0 && !unlimited)
+  /* Check for F08:C628 (F2018:C932).  Each allocate-object shall be a data
+     pointer or an allocatable variable.  */
+  if (allocatable == 0 && pointer == 0)
     {
       gfc_error ("Allocate-object at %L must be ALLOCATABLE or a POINTER",
 		 &e->where);
-- 
cgit v1.1


From a7083b83e45852540a4a09ee11b74dc28d777399 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 30 Aug 2021 23:07:56 +0200
Subject: Fortran - fix whitespace issue during parsing of assigned goto

gcc/fortran/ChangeLog:

	PR fortran/102113
	* match.c (gfc_match_goto): Allow for whitespace in parsing list
	of labels.

gcc/testsuite/ChangeLog:

	PR fortran/102113
	* gfortran.dg/goto_9.f90: New test.
---
 gcc/fortran/match.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 16502da..53a575e 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -4079,7 +4079,7 @@ gfc_match_goto (void)
 	}
       while (gfc_match_char (',') == MATCH_YES);
 
-      if (gfc_match (")%t") != MATCH_YES)
+      if (gfc_match (" )%t") != MATCH_YES)
 	goto syntax;
 
       if (head == NULL)
-- 
cgit v1.1


From 1e2f030b80cb650708b02086dbd5431cd231495f Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Tue, 31 Aug 2021 00:16:50 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cfda885..ffdc8dc 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2021-08-30  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/102113
+	* match.c (gfc_match_goto): Allow for whitespace in parsing list
+	of labels.
+
+2021-08-30  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/101349
+	* resolve.c (resolve_allocate_expr): An unlimited polymorphic
+	argument to ALLOCATE must be ALLOCATABLE or a POINTER.  Fix the
+	corresponding check.
+
 2021-08-28  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/87737
-- 
cgit v1.1


From 03be3cfeef7b3811acb6c4a8da2fc5c1e25d3e4c Mon Sep 17 00:00:00 2001
From: Marcel Vollweiler <marcel@codesourcery.com>
Date: Tue, 31 Aug 2021 06:09:40 -0700
Subject: Add support for device-modifiers for 'omp target device'.

'device_num' and 'ancestor' are now parsed on target device constructs for C,
C++, and Fortran (see OpenMP specification 5.0, p. 170). When 'ancestor' is
 used, then 'sorry, not supported' is output. Moreover, the restrictions for
'ancestor' are implemented (see OpenMP specification 5.0, p. 174f).

gcc/c/ChangeLog:

	* c-parser.c (c_parser_omp_clause_device): Parse device-modifiers 'device_num'
	and 'ancestor' in 'target device' clauses.

gcc/cp/ChangeLog:

	* parser.c (cp_parser_omp_clause_device): Parse device-modifiers 'device_num'
	and 'ancestor' in 'target device' clauses.
	* semantics.c (finish_omp_clauses): Error handling. Constant device ids must
	evaluate to '1' if 'ancestor' is used.

gcc/fortran/ChangeLog:

	* gfortran.h: Add variable for 'ancestor' in struct gfc_omp_clauses.
	* openmp.c (gfc_match_omp_clauses): Parse device-modifiers 'device_num'
	and 'ancestor' in 'target device' clauses.
	* trans-openmp.c (gfc_trans_omp_clauses): Set OMP_CLAUSE_DEVICE_ANCESTOR.

gcc/ChangeLog:

	* gimplify.c (gimplify_scan_omp_clauses): Error handling. 'ancestor' only
	allowed on target constructs and only with particular other clauses.
	* omp-expand.c (expand_omp_target): Output of 'sorry, not supported' if
	'ancestor' is used.
	* omp-low.c (check_omp_nesting_restrictions): Error handling. No nested OpenMP
	structs when 'ancestor' is used.
	(scan_omp_1_stmt): No usage of OpenMP runtime routines in a target region when
	'ancestor' is used.
	* tree-pretty-print.c (dump_omp_clause): Append 'ancestor'.
	* tree.h (OMP_CLAUSE_DEVICE_ANCESTOR): Define macro.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/target-device-1.c: New test.
	* c-c++-common/gomp/target-device-2.c: New test.
	* c-c++-common/gomp/target-device-ancestor-1.c: New test.
	* c-c++-common/gomp/target-device-ancestor-2.c: New test.
	* c-c++-common/gomp/target-device-ancestor-3.c: New test.
	* c-c++-common/gomp/target-device-ancestor-4.c: New test.
	* gfortran.dg/gomp/target-device-1.f90: New test.
	* gfortran.dg/gomp/target-device-2.f90: New test.
	* gfortran.dg/gomp/target-device-ancestor-1.f90: New test.
	* gfortran.dg/gomp/target-device-ancestor-2.f90: New test.
	* gfortran.dg/gomp/target-device-ancestor-3.f90: New test.
	* gfortran.dg/gomp/target-device-ancestor-4.f90: New test.
---
 gcc/fortran/gfortran.h     |  1 +
 gcc/fortran/openmp.c       | 47 ++++++++++++++++++++++++++++++++++++++++++++--
 gcc/fortran/trans-openmp.c |  4 ++++
 3 files changed, 50 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 48cdcdf..fdf556e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1482,6 +1482,7 @@ typedef struct gfc_omp_clauses
   struct gfc_expr *dist_chunk_size;
   struct gfc_expr *message;
   const char *critical_name;
+  bool ancestor;
   enum gfc_omp_default_sharing default_sharing;
   enum gfc_omp_atomic_op atomic_op;
   enum gfc_omp_defaultmap defaultmap[OMP_DEFAULTMAP_CAT_NUM];
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 715fd32..64ecd54 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1825,11 +1825,54 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	    continue;
 	  if ((mask & OMP_CLAUSE_DEVICE)
 	      && !openacc
-	      && (m = gfc_match_dupl_check (!c->device, "device", true,
-					    &c->device)) != MATCH_NO)
+	      && ((m = gfc_match_dupl_check (!c->device, "device", true))
+		  != MATCH_NO))
 	    {
 	      if (m == MATCH_ERROR)
 		goto error;
+	      c->ancestor = false;
+	      if (gfc_match ("device_num : ") == MATCH_YES)
+		{
+		  if (gfc_match ("%e )", &c->device) != MATCH_YES)
+		    {
+		      gfc_error ("Expected integer expression at %C");
+		      break;
+		    }
+		}
+	      else if (gfc_match ("ancestor : ") == MATCH_YES)
+		{
+		  c->ancestor = true;
+		  if (!(gfc_current_ns->omp_requires & OMP_REQ_REVERSE_OFFLOAD))
+		    {
+		      gfc_error ("%<ancestor%> device modifier not "
+				 "preceded by %<requires%> directive "
+				 "with %<reverse_offload%> clause at %C");
+		      break;
+		    }
+		  locus old_loc2 = gfc_current_locus;
+		  if (gfc_match ("%e )", &c->device) == MATCH_YES)
+		    {
+		      int device = 0;
+		      if (!gfc_extract_int (c->device, &device) && device != 1)
+		      {
+			gfc_current_locus = old_loc2;
+			gfc_error ("the %<device%> clause expression must "
+				   "evaluate to %<1%> at %C");
+			break;
+		      }
+		    }
+		  else
+		    {
+		      gfc_error ("Expected integer expression at %C");
+		      break;
+		    }
+		}
+	      else if (gfc_match ("%e )", &c->device) != MATCH_YES)
+		{
+		  gfc_error ("Expected integer expression or a single device-"
+			      "modifier %<device_num%> or %<ancestor%> at %C");
+		  break;
+		}
 	      continue;
 	    }
 	  if ((mask & OMP_CLAUSE_DEVICE)
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 40d2fd2..6f9b0e3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -3950,6 +3950,10 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 
       c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_DEVICE);
       OMP_CLAUSE_DEVICE_ID (c) = device;
+
+      if (clauses->ancestor)
+	OMP_CLAUSE_DEVICE_ANCESTOR (c) = 1;
+
       omp_clauses = gfc_trans_add_clause (c, omp_clauses);
     }
 
-- 
cgit v1.1


From e4cb3bb9ac11b4126ffa718287dd509a4b10a658 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 31 Aug 2021 21:00:53 +0200
Subject: Fortran - extend set of substring expressions handled in length
 simplification

gcc/fortran/ChangeLog:

	PR fortran/100950
	* simplify.c (substring_has_constant_len): Minimize checks for
	substring expressions being allowed.

gcc/testsuite/ChangeLog:

	PR fortran/100950
	* gfortran.dg/pr100950.f90: Extend coverage.
---
 gcc/fortran/simplify.c | 31 ++-----------------------------
 1 file changed, 2 insertions(+), 29 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 4cb73e8..b46cbfa 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -4533,14 +4533,7 @@ substring_has_constant_len (gfc_expr *e)
       || !ref->u.ss.start
       || ref->u.ss.start->expr_type != EXPR_CONSTANT
       || !ref->u.ss.end
-      || ref->u.ss.end->expr_type != EXPR_CONSTANT
-      || !ref->u.ss.length)
-    return false;
-
-  /* For non-deferred strings the given length shall be constant.  */
-  if (!e->ts.deferred
-      && (!ref->u.ss.length->length
-	  || ref->u.ss.length->length->expr_type != EXPR_CONSTANT))
+      || ref->u.ss.end->expr_type != EXPR_CONSTANT)
     return false;
 
   /* Basic checks on substring starting and ending indices.  */
@@ -4551,27 +4544,7 @@ substring_has_constant_len (gfc_expr *e)
   iend = gfc_mpz_get_hwi (ref->u.ss.end->value.integer);
 
   if (istart <= iend)
-    {
-      if (istart < 1)
-	{
-	  gfc_error ("Substring start index (%wd) at %L below 1",
-		     istart, &ref->u.ss.start->where);
-	  return false;
-	}
-
-      /* For deferred strings use end index as proxy for length.  */
-      if (e->ts.deferred)
-	length = iend;
-      else
-	length = gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer);
-      if (iend > length)
-	{
-	  gfc_error ("Substring end index (%wd) at %L exceeds string length",
-		     iend, &ref->u.ss.end->where);
-	  return false;
-	}
-      length = iend - istart + 1;
-    }
+    length = iend - istart + 1;
   else
     length = 0;
 
-- 
cgit v1.1


From 6d51ee4321605c704aa238d039b47bfcf59b1005 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 1 Sep 2021 00:16:58 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ffdc8dc..e30d165 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2021-08-31  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/100950
+	* simplify.c (substring_has_constant_len): Minimize checks for
+	substring expressions being allowed.
+
+2021-08-31  Marcel Vollweiler  <marcel@codesourcery.com>
+
+	* gfortran.h: Add variable for 'ancestor' in struct gfc_omp_clauses.
+	* openmp.c (gfc_match_omp_clauses): Parse device-modifiers 'device_num'
+	and 'ancestor' in 'target device' clauses.
+	* trans-openmp.c (gfc_trans_omp_clauses): Set OMP_CLAUSE_DEVICE_ANCESTOR.
+
 2021-08-30  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/102113
-- 
cgit v1.1


From a88280cff3436d0b6ab454514e5a3b97a543e9a5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Wed, 1 Sep 2021 19:05:47 +0200
Subject: Fortran - improve wording of error message

gcc/fortran/ChangeLog:

	PR fortran/56985
	* resolve.c (resolve_common_vars): Fix grammar and improve wording
	of error message rejecting an unlimited polymorphic in COMMON.
---
 gcc/fortran/resolve.c | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d7aa286..8e5ed1c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -979,7 +979,7 @@ resolve_common_vars (gfc_common_head *common_block, bool named_common)
 	}
 
       if (UNLIMITED_POLY (csym))
-	gfc_error_now ("%qs in cannot appear in COMMON at %L "
+	gfc_error_now ("%qs at %L cannot appear in COMMON "
 		       "[F2008:C5100]", csym->name, &csym->declared_at);
 
       if (csym->ts.type != BT_DERIVED)
-- 
cgit v1.1


From e11c6046f9c8bc891a67f37f0260ef4ece482f5d Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 2 Sep 2021 00:16:59 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e30d165..9fafc5e 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-09-01  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/56985
+	* resolve.c (resolve_common_vars): Fix grammar and improve wording
+	of error message rejecting an unlimited polymorphic in COMMON.
+
 2021-08-31  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/100950
-- 
cgit v1.1


From 943c65c4494145e993af43c821c82000013c6375 Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Fri, 3 Sep 2021 16:28:04 +0200
Subject: Fortran: Fix Bind(C) char-len check, add ptr-contiguous check

Add F2018, 18.3.6 (5), pointer + contiguous is not permitted
check for dummies in BIND(C) procs.

Fix misreading of F2018, 18.3.4/18.3.5 + 18.3.6 (5) regarding
character dummies passed as byte stream to a bind(C) dummy arg:
Per F2018, 18.3.1 only len=1 is interoperable (since F2003).
F2008 added 'constant expression' for vars (F2018, 18.3.4/18.3.5),
applicable to dummy args per F2018, C1554. I misread this such
that len > 1 is permitted if len is a constant expr.

While the latter would work as character len=1 a(10) and len=2 a(5)
have the same storage sequence and len is fixed, it is still invalid.
Hence, it is now rejected again.

gcc/fortran/ChangeLog:

	* decl.c (gfc_verify_c_interop_param): Reject pointer with
	CONTIGUOUS attributes as dummy arg. Reject character len > 1
	when passed as byte stream.

gcc/testsuite/ChangeLog:

	* gfortran.dg/bind_c_char_6.f90: Update dg-error.
	* gfortran.dg/bind_c_char_7.f90: Likewise.
	* gfortran.dg/bind_c_char_8.f90: Likewise.
	* gfortran.dg/iso_c_binding_char_1.f90: Likewise.
	* gfortran.dg/pr32599.f03: Likewise.
	* gfortran.dg/bind_c_char_9.f90: Comment testcase bits which are
	implementable but not valid F2018.
	* gfortran.dg/bind_c_contiguous.f90: New test.
---
 gcc/fortran/decl.c | 39 ++++++++++++++++-----------------------
 1 file changed, 16 insertions(+), 23 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 05081c4..2e49a67 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1551,11 +1551,15 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 			     sym->ns->proc_name->name);
 	    }
 
+	  /* Per F2018, 18.3.6 (5), pointer + contiguous is not permitted.  */
+	  if (sym->attr.pointer && sym->attr.contiguous)
+	    gfc_error ("Dummy argument %qs at %L may not be a pointer with "
+		       "CONTIGUOUS attribute as procedure %qs is BIND(C)",
+		       sym->name, &sym->declared_at, sym->ns->proc_name->name);
+
           /* Character strings are only C interoperable if they have a
-	     length of 1.  However, as argument they are either iteroperable
-	     when passed as descriptor (which requires len=: or len=*) or
-	     when having a constant length or are always passed by
-	     descriptor.  */
+	     length of 1.  However, as an argument they are also iteroperable
+	     when passed as descriptor (which requires len=: or len=*).  */
 	  if (sym->ts.type == BT_CHARACTER)
 	    {
 	      gfc_charlen *cl = sym->ts.u.cl;
@@ -1607,7 +1611,8 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 	      else if (!cl || !cl->length)
 		{
 		  /* Assumed length; F2018, 18.3.6 (5)(2).
-		     Uses the CFI array descriptor.  */
+		     Uses the CFI array descriptor - also for scalars and
+		     explicit-size/assumed-size arrays.  */
 		  if (!gfc_notify_std (GFC_STD_F2018,
 				      "Assumed-length character dummy argument "
 				      "%qs at %L of procedure %qs with BIND(C) "
@@ -1629,7 +1634,8 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 		      retval = false;
 		    }
 		}
-	      else if (cl->length->expr_type != EXPR_CONSTANT)
+	      else if (cl->length->expr_type != EXPR_CONSTANT
+		       || mpz_cmp_si (cl->length->value.integer, 1) != 0)
 		{
 		  /* F2018, 18.3.6, (5), item 4.  */
 		  if (!sym->attr.dimension
@@ -1637,30 +1643,17 @@ gfc_verify_c_interop_param (gfc_symbol *sym)
 		      || sym->as->type == AS_EXPLICIT)
 		    {
 		      gfc_error ("Character dummy argument %qs at %L must be "
-				 "of constant length or assumed length, "
+				 "of constant length of one or assumed length, "
 				 "unless it has assumed shape or assumed rank, "
 				 "as procedure %qs has the BIND(C) attribute",
 				 sym->name, &sym->declared_at,
 				 sym->ns->proc_name->name);
 		      retval = false;
 		    }
-		  else if (!gfc_notify_std (GFC_STD_F2018,
-					    "Character dummy argument %qs at "
-					    "%L with nonconstant length as "
-					    "procedure %qs is BIND(C)",
-					    sym->name, &sym->declared_at,
-					    sym->ns->proc_name->name))
-		    retval = false;
+		  /* else: valid only since F2018 - and an assumed-shape/rank
+		     array; however, gfc_notify_std is already called when
+		     those array types are used. Thus, silently accept F200x. */
 		}
-	     else if (mpz_cmp_si (cl->length->value.integer, 1) != 0
-		      && !gfc_notify_std (GFC_STD_F2008,
-					  "Character dummy argument %qs at %L "
-					  "with length greater than 1 for "
-					  "procedure %qs with BIND(C) "
-					  "attribute",
-					  sym->name, &sym->declared_at,
-					  sym->ns->proc_name->name))
-	       retval = false;
 	    }
 
 	  /* We have to make sure that any param to a bind(c) routine does
-- 
cgit v1.1


From 7b7395409c7aaef493337479c7fd586e52aea3d1 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Sat, 4 Sep 2021 00:16:38 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 6 ++++++
 1 file changed, 6 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9fafc5e..6306971 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2021-09-03  Tobias Burnus  <tobias@codesourcery.com>
+
+	* decl.c (gfc_verify_c_interop_param): Reject pointer with
+	CONTIGUOUS attributes as dummy arg. Reject character len > 1
+	when passed as byte stream.
+
 2021-09-01  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/56985
-- 
cgit v1.1


From ba1cc6956b956eb5b92c45af79a8b1fe426ec4d3 Mon Sep 17 00:00:00 2001
From: Marcel Vollweiler <marcel@codesourcery.com>
Date: Tue, 7 Sep 2021 03:46:28 -0700
Subject: C, C++, Fortran, OpenMP: Add support for 'flush seq_cst' construct.

This patch adds support for the 'seq_cst' memory order clause on the 'flush'
directive which was introduced in OpenMP 5.1.

gcc/c-family/ChangeLog:

	* c-omp.c (c_finish_omp_flush): Handle MEMMODEL_SEQ_CST.

gcc/c/ChangeLog:

	* c-parser.c (c_parser_omp_flush): Parse 'seq_cst' clause on 'flush'
	directive.

gcc/cp/ChangeLog:

	* parser.c (cp_parser_omp_flush): Parse 'seq_cst' clause on 'flush'
	directive.
	* semantics.c (finish_omp_flush): Handle MEMMODEL_SEQ_CST.

gcc/fortran/ChangeLog:

	* openmp.c (gfc_match_omp_flush): Parse 'seq_cst' clause on 'flush'
	directive.
	* trans-openmp.c (gfc_trans_omp_flush): Handle OMP_MEMORDER_SEQ_CST.

gcc/testsuite/ChangeLog:

	* c-c++-common/gomp/flush-1.c: Add test case for 'seq_cst'.
	* c-c++-common/gomp/flush-2.c: Add test case for 'seq_cst'.
	* g++.dg/gomp/attrs-1.C: Adapt test to handle all flush clauses.
	* g++.dg/gomp/attrs-2.C: Adapt test to handle all flush clauses.
	* gfortran.dg/gomp/flush-1.f90: Add test case for 'seq_cst'.
	* gfortran.dg/gomp/flush-2.f90: Add test case for 'seq_cst'.
---
 gcc/fortran/openmp.c       | 6 ++++--
 gcc/fortran/trans-openmp.c | 3 ++-
 2 files changed, 6 insertions(+), 3 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 64ecd54..a64b7f5 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -3782,7 +3782,9 @@ gfc_match_omp_flush (void)
   enum gfc_omp_memorder mo = OMP_MEMORDER_UNSET;
   if (gfc_match_omp_eos () == MATCH_NO && gfc_peek_ascii_char () != '(')
     {
-      if (gfc_match ("acq_rel") == MATCH_YES)
+      if (gfc_match ("seq_cst") == MATCH_YES)
+	mo = OMP_MEMORDER_SEQ_CST;
+      else if (gfc_match ("acq_rel") == MATCH_YES)
 	mo = OMP_MEMORDER_ACQ_REL;
       else if (gfc_match ("release") == MATCH_YES)
 	mo = OMP_MEMORDER_RELEASE;
@@ -3790,7 +3792,7 @@ gfc_match_omp_flush (void)
 	mo = OMP_MEMORDER_ACQUIRE;
       else
 	{
-	  gfc_error ("Expected AQC_REL, RELEASE, or ACQUIRE at %C");
+	  gfc_error ("Expected SEQ_CST, AQC_REL, RELEASE, or ACQUIRE at %C");
 	  return MATCH_ERROR;
 	}
       c = gfc_get_omp_clauses ();
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 6f9b0e3..e55e0c8 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -5413,7 +5413,8 @@ gfc_trans_omp_flush (gfc_code *code)
 {
   tree call;
   if (!code->ext.omp_clauses
-      || code->ext.omp_clauses->memorder == OMP_MEMORDER_UNSET)
+      || code->ext.omp_clauses->memorder == OMP_MEMORDER_UNSET
+      || code->ext.omp_clauses->memorder == OMP_MEMORDER_SEQ_CST)
     {
       call = builtin_decl_explicit (BUILT_IN_SYNC_SYNCHRONIZE);
       call = build_call_expr_loc (input_location, call, 0);
-- 
cgit v1.1


From 2a1537a19cb2fa85823cfa18ed40baa4b259b4e3 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Tue, 7 Sep 2021 20:51:49 +0200
Subject: Fortran - improve error recovery determining array element from
 constructor

gcc/fortran/ChangeLog:

	PR fortran/101327
	* expr.c (find_array_element): When bounds cannot be determined as
	constant, return error instead of aborting.

gcc/testsuite/ChangeLog:

	PR fortran/101327
	* gfortran.dg/pr101327.f90: New test.
---
 gcc/fortran/expr.c | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 35563a7..dfecc30 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1337,7 +1337,9 @@ find_array_element (gfc_constructor_base base, gfc_array_ref *ar,
   for (i = 0; i < ar->dimen; i++)
     {
       if (!gfc_reduce_init_expr (ar->as->lower[i])
-	  || !gfc_reduce_init_expr (ar->as->upper[i]))
+	  || !gfc_reduce_init_expr (ar->as->upper[i])
+	  || ar->as->upper[i]->expr_type != EXPR_CONSTANT
+	  || ar->as->lower[i]->expr_type != EXPR_CONSTANT)
 	{
 	  t = false;
 	  cons = NULL;
@@ -1351,9 +1353,6 @@ find_array_element (gfc_constructor_base base, gfc_array_ref *ar,
 	  goto depart;
 	}
 
-      gcc_assert (ar->as->upper[i]->expr_type == EXPR_CONSTANT
-		  && ar->as->lower[i]->expr_type == EXPR_CONSTANT);
-
       /* Check the bounds.  */
       if ((ar->as->upper[i]
 	   && mpz_cmp (e->value.integer,
-- 
cgit v1.1


From b2748138c05c6fba1a34f54980b6382bc6332f56 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Wed, 8 Sep 2021 00:16:23 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 12 ++++++++++++
 1 file changed, 12 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6306971..6c479da 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2021-09-07  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/101327
+	* expr.c (find_array_element): When bounds cannot be determined as
+	constant, return error instead of aborting.
+
+2021-09-07  Marcel Vollweiler  <marcel@codesourcery.com>
+
+	* openmp.c (gfc_match_omp_flush): Parse 'seq_cst' clause on 'flush'
+	directive.
+	* trans-openmp.c (gfc_trans_omp_flush): Handle OMP_MEMORDER_SEQ_CST.
+
 2021-09-03  Tobias Burnus  <tobias@codesourcery.com>
 
 	* decl.c (gfc_verify_c_interop_param): Reject pointer with
-- 
cgit v1.1


From f19a327077ecc34a51487761378b9edb43c82997 Mon Sep 17 00:00:00 2001
From: liuhongt <hongtao.liu@intel.com>
Date: Mon, 2 Aug 2021 10:56:45 +0800
Subject: Support -fexcess-precision=16 which will enable
 FLT_EVAL_METHOD_PROMOTE_TO_FLOAT16 when backend supports _Float16.

gcc/ada/ChangeLog:

	* gcc-interface/misc.c (gnat_post_options): Issue an error for
	-fexcess-precision=16.

gcc/c-family/ChangeLog:

	* c-common.c (excess_precision_mode_join): Update below comments.
	(c_ts18661_flt_eval_method): Set excess_precision_type to
	EXCESS_PRECISION_TYPE_FLOAT16 when -fexcess-precision=16.
	* c-cppbuiltin.c (cpp_atomic_builtins): Update below comments.
	(c_cpp_flt_eval_method_iec_559): Set excess_precision_type to
	EXCESS_PRECISION_TYPE_FLOAT16 when -fexcess-precision=16.

gcc/ChangeLog:

	* common.opt: Support -fexcess-precision=16.
	* config/aarch64/aarch64.c (aarch64_excess_precision): Return
	FLT_EVAL_METHOD_PROMOTE_TO_FLOAT16 when
	EXCESS_PRECISION_TYPE_FLOAT16.
	* config/arm/arm.c (arm_excess_precision): Ditto.
	* config/i386/i386.c (ix86_get_excess_precision): Ditto.
	* config/m68k/m68k.c (m68k_excess_precision): Issue an error
	when EXCESS_PRECISION_TYPE_FLOAT16.
	* config/s390/s390.c (s390_excess_precision): Ditto.
	* coretypes.h (enum excess_precision_type): Add
	EXCESS_PRECISION_TYPE_FLOAT16.
	* doc/tm.texi (TARGET_C_EXCESS_PRECISION): Update documents.
	* doc/tm.texi.in (TARGET_C_EXCESS_PRECISION): Ditto.
	* doc/extend.texi (Half-Precision): Document
	-fexcess-precision=16.
	* flag-types.h (enum excess_precision): Add
	EXCESS_PRECISION_FLOAT16.
	* target.def (excess_precision): Update document.
	* tree.c (excess_precision_type): Set excess_precision_type to
	EXCESS_PRECISION_FLOAT16 when -fexcess-precision=16.

gcc/fortran/ChangeLog:

	* options.c (gfc_post_options): Issue an error for
	-fexcess-precision=16.

gcc/testsuite/ChangeLog:

	* gcc.target/i386/float16-6.c: New test.
	* gcc.target/i386/float16-7.c: New test.
---
 gcc/fortran/options.c | 3 +++
 1 file changed, 3 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 1723f68..847e20e 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -267,6 +267,9 @@ gfc_post_options (const char **pfilename)
      support.  */
   if (flag_excess_precision == EXCESS_PRECISION_STANDARD)
     sorry ("%<-fexcess-precision=standard%> for Fortran");
+  else if (flag_excess_precision == EXCESS_PRECISION_FLOAT16)
+    sorry ("%<-fexcess-precision=16%> for Fortran");
+
   flag_excess_precision = EXCESS_PRECISION_FAST;
 
   /* Fortran allows associative math - but we cannot reassociate if
-- 
cgit v1.1


From b6db7cd41ccf821ffb10ff4f18845465e98803cd Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Thu, 9 Sep 2021 00:16:32 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 5 +++++
 1 file changed, 5 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6c479da..2b148f1 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2021-09-08  liuhongt  <hongtao.liu@intel.com>
+
+	* options.c (gfc_post_options): Issue an error for
+	-fexcess-precision=16.
+
 2021-09-07  Harald Anlauf  <anlauf@gmx.de>
 
 	PR fortran/101327
-- 
cgit v1.1


From 5fe0865ab788bdc387b284a3ad57e5a95a767b18 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Thu, 9 Sep 2021 21:34:01 +0200
Subject: Fortran - out of bounds in array constructor with implied do loop

gcc/fortran/ChangeLog:

	PR fortran/98490
	* trans-expr.c (gfc_conv_substring): Do not generate substring
	bounds check for implied do loop index variable before it actually
	becomes defined.

gcc/testsuite/ChangeLog:

	PR fortran/98490
	* gfortran.dg/bounds_check_23.f90: New test.
---
 gcc/fortran/trans-expr.c | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c4291cc..18d6651 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2630,7 +2630,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
   if (!CONSTANT_CLASS_P (tmp) && !DECL_P (tmp))
     end.expr = gfc_evaluate_now (end.expr, &se->pre);
 
-  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+  if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+      && (ref->u.ss.start->symtree
+	  && !ref->u.ss.start->symtree->n.sym->attr.implied_index))
     {
       tree nonempty = fold_build2_loc (input_location, LE_EXPR,
 				       logical_type_node, start.expr,
-- 
cgit v1.1


From f84e2f0b7b022123232eb30d579984a8c1880782 Mon Sep 17 00:00:00 2001
From: GCC Administrator <gccadmin@gcc.gnu.org>
Date: Fri, 10 Sep 2021 00:16:31 +0000
Subject: Daily bump.

---
 gcc/fortran/ChangeLog | 7 +++++++
 1 file changed, 7 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2b148f1..991f3cf 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2021-09-09  Harald Anlauf  <anlauf@gmx.de>
+
+	PR fortran/98490
+	* trans-expr.c (gfc_conv_substring): Do not generate substring
+	bounds check for implied do loop index variable before it actually
+	becomes defined.
+
 2021-09-08  liuhongt  <hongtao.liu@intel.com>
 
 	* options.c (gfc_post_options): Issue an error for
-- 
cgit v1.1


From 8d93ba93d3b13ac3d3c34404cad87732c809605b Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 13 Sep 2021 19:26:35 +0200
Subject: Fortran - fix handling of substring start and end indices

gcc/fortran/ChangeLog:

	PR fortran/85130
	* expr.c (find_substring_ref): Handle given substring start and
	end indices as signed integers, not unsigned.

gcc/testsuite/ChangeLog:

	PR fortran/85130
	* gfortran.dg/substr_6.f90: Revert commit r8-7574, adding again
	test that was erroneously considered as illegal.
---
 gcc/fortran/expr.c | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index dfecc30..604e63e 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1724,8 +1724,8 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
   *newp = gfc_copy_expr (p);
   free ((*newp)->value.character.string);
 
-  end = (gfc_charlen_t) mpz_get_ui (p->ref->u.ss.end->value.integer);
-  start = (gfc_charlen_t) mpz_get_ui (p->ref->u.ss.start->value.integer);
+  end = (gfc_charlen_t) mpz_get_si (p->ref->u.ss.end->value.integer);
+  start = (gfc_charlen_t) mpz_get_si (p->ref->u.ss.start->value.integer);
   if (end >= start)
     length = end - start + 1;
   else
-- 
cgit v1.1


From 104c05c5284b7822d770ee51a7d91946c7e56d50 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Mon, 13 Sep 2021 19:28:10 +0200
Subject: Fortran - ensure simplification of bounds of array-valued named
 constants

gcc/fortran/ChangeLog:

	PR fortran/82314
	* decl.c (add_init_expr_to_sym): For proper initialization of
	array-valued named constants the array bounds need to be
	simplified before adding the initializer.

gcc/testsuite/ChangeLog:

	PR fortran/82314
	* gfortran.dg/pr82314.f90: New test.
---
 gcc/fortran/decl.c | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'gcc/fortran')

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2e49a67..f2e8896 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2169,6 +2169,24 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
 	  sym->as->type = AS_EXPLICIT;
 	}
 
+      /* Ensure that explicit bounds are simplified.  */
+      if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension
+	  && sym->as->type == AS_EXPLICIT)
+	{
+	  for (int dim = 0; dim < sym->as->rank; ++dim)
+	    {
+	      gfc_expr *e;
+
+	      e = sym->as->lower[dim];
+	      if (e->expr_type != EXPR_CONSTANT)
+		gfc_reduce_init_expr (e);
+
+	      e = sym->as->upper[dim];
+	      if (e->expr_type != EXPR_CONSTANT)
+		gfc_reduce_init_expr (e);
+	    }
+	}
+
       /* Need to check if the expression we initialized this
 	 to was one of the iso_c_binding named constants.  If so,
 	 and we're a parameter (constant), let it be iso_c.
-- 
cgit v1.1