[WIP, OpenMP] OpenMP metadirectives support

[WIP, OpenMP] OpenMP metadirectives support

[Kwok Cheung Yeung]

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

Hello

This is a WIP implementation of metadirectives as defined in the OpenMP 5.0 
spec. I intend to add support for metadirectives as specified in OpenMP 5.1 
later (where the directive can be selected dynamically at runtime), but am 
concentrating on the static part for now. Parsing has only been implemented in 
the C frontend so far. I am especially interested in feedback regarding certain 
aspects of the implementation before I become too committed to the current design.

1) When parsing each directive variant, a vector of tokens is constructed and 
populated with the tokens for a regular equivalent pragma, along with the tokens 
for its clauses and the body. The parser routine for that pragma type is then 
called with these tokens, and the entire resulting parse tree is stored as a 
sub-tree of the metadirective tree structure.

This results in the body being parsed and stored once for each directive 
variant. I believe this is necessary because the body is parsed differently if 
there is a 'for' in the directive (using c_parser_omp_for_loop) compared to if 
there is not, plus clauses in the directive (e.g. tile, collapse) can change how 
the for loop is parsed.

As an optimisation, identical body trees could be merged together, but that can 
come later.

2) Selectors in the device set (i.e. kind, isa, arch) resolve differently 
depending on whether the program is running on a target or on the host. Since we 
don't keep multiple versions of a function for each target on the host compiler, 
resolving metadirectives with these selectors needs to be delayed until after 
LTO streaming, at which point the host or offload compiler can make the 
appropriate decision.

One negative of this is that the metadirective Gimple representation lasts 
beyond the OMP expand stage, when generally we would expect all OMP directives 
to have been expanded to something else.

3) In the OpenMP examples (version 5.0.1), section 9.7, the example 
metadirective.3.c does not work as expected.

#pragma omp declare target
void exp_pi_diff(double *d, double my_pi){
    #pragma omp metadirective \
                when( construct={target}: distribute parallel for ) \
                default( parallel for simd)
...
int main()
{
    ...
    #pragma omp target teams map(tofrom: d[0:N])
    exp_pi_diff(d,my_pi);
    ...
    exp_pi_diff(d,my_pi);

In the first call to exp_pi_diff in an '#pragma omp target' construct, the 
metadirective is expected to expand to 'distribute parallel for', but in the 
second (without the '#pragma omp target'), it should expand to 'parallel for simd'.

During OMP expansion of the 'omp target', it creates a child function that calls 
exp_pi_diff:

__attribute__((omp target entrypoint))
void main._omp_fn.0 (const struct .omp_data_t.12 & restrict .omp_data_i)
{
   ...
   <bb 4> :
   __builtin_GOMP_teams (0, 0);
   exp_pi_diff (d.13, my_pi);

This is not a problem on the offload compiler (since by definition its copy of 
exp_pi_diff must be in a 'target'), but if the host device is used, the same 
version of exp_pi_diff is called in both target and non-target contexts.

What would be the best way to solve this? Offhand, I can think of two solutions:

(a) Recursively go through all functions that can be reached via a target region 
and create clones for each, redirecting all function calls in the clones to the 
new cloned versions. Resolve the metadirectives in the clones and originals 
separately.

(b) Make the construct selector a dynamic selector when OpenMP 5.1 metadirective 
support is implemented. Keep track of the current construct list every time an 
OpenMP construct is entered or exited, and make the decision at runtime.


Thanks

Kwok

[-- Attachment #2: omp_metadirectives_wip.patch --]
[-- Type: text/plain, Size: 57697 bytes --]

diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index 1164554e6d6..28e29fab93d 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -1505,6 +1505,7 @@ OBJS = \
 	omp-general.o \
 	omp-low.o \
 	omp-oacc-kernels-decompose.o \
+        omp-expand-metadirective.o \
 	omp-simd-clone.o \
 	opt-problem.o \
 	optabs.o \
diff --git a/gcc/c-family/c-pragma.c b/gcc/c-family/c-pragma.c
index 4f8e8e0128c..01dc1e6d9c0 100644
--- a/gcc/c-family/c-pragma.c
+++ b/gcc/c-family/c-pragma.c
@@ -1312,12 +1312,14 @@ static const struct omp_pragma_def omp_pragmas[] = {
   { "allocate", PRAGMA_OMP_ALLOCATE },
   { "atomic", PRAGMA_OMP_ATOMIC },
   { "barrier", PRAGMA_OMP_BARRIER },
+  { "begin", PRAGMA_OMP_BEGIN },
   { "cancel", PRAGMA_OMP_CANCEL },
   { "cancellation", PRAGMA_OMP_CANCELLATION_POINT },
   { "critical", PRAGMA_OMP_CRITICAL },
   { "depobj", PRAGMA_OMP_DEPOBJ },
-  { "end", PRAGMA_OMP_END_DECLARE_TARGET },
+  { "end", PRAGMA_OMP_END },
   { "flush", PRAGMA_OMP_FLUSH },
+  { "metadirective", PRAGMA_OMP_METADIRECTIVE },
   { "requires", PRAGMA_OMP_REQUIRES },
   { "section", PRAGMA_OMP_SECTION },
   { "sections", PRAGMA_OMP_SECTIONS },
@@ -1387,6 +1389,41 @@ c_pp_lookup_pragma (unsigned int id, const char **space, const char **name)
   gcc_unreachable ();
 }
 
+static int
+c_pp_lookup_pragma_by_name_1 (const void *name, const void *elem)
+{
+  const struct omp_pragma_def *pragma_def
+    = (const struct omp_pragma_def *) elem;
+
+  return strcmp ((const char *) name, pragma_def->name);
+}
+
+enum pragma_kind
+c_pp_lookup_pragma_by_name (const char *name)
+{
+  const int n_omp_pragmas = sizeof (omp_pragmas) / sizeof (*omp_pragmas);
+  const int n_omp_pragmas_simd = sizeof (omp_pragmas_simd)
+				 / sizeof (*omp_pragmas_simd);
+
+  void *result = bsearch (name, omp_pragmas, n_omp_pragmas,
+			  sizeof (*omp_pragmas),
+			  c_pp_lookup_pragma_by_name_1);
+  if (!result)
+    result = bsearch (name, omp_pragmas_simd, n_omp_pragmas_simd,
+		      sizeof (*omp_pragmas_simd),
+		      c_pp_lookup_pragma_by_name_1);
+
+  if (result)
+    {
+      const struct omp_pragma_def *def
+	= (const struct omp_pragma_def *) result;
+
+      return (enum pragma_kind) def->id;
+    }
+
+  return PRAGMA_NONE;
+}
+
 /* Front-end wrappers for pragma registration to avoid dragging
    cpplib.h in almost everywhere.  */
 
diff --git a/gcc/c-family/c-pragma.h b/gcc/c-family/c-pragma.h
index 6c34ffa5be4..6d4698d41ba 100644
--- a/gcc/c-family/c-pragma.h
+++ b/gcc/c-family/c-pragma.h
@@ -45,17 +45,19 @@ enum pragma_kind {
   PRAGMA_OMP_ALLOCATE,
   PRAGMA_OMP_ATOMIC,
   PRAGMA_OMP_BARRIER,
+  PRAGMA_OMP_BEGIN,
   PRAGMA_OMP_CANCEL,
   PRAGMA_OMP_CANCELLATION_POINT,
   PRAGMA_OMP_CRITICAL,
   PRAGMA_OMP_DECLARE,
   PRAGMA_OMP_DEPOBJ,
   PRAGMA_OMP_DISTRIBUTE,
-  PRAGMA_OMP_END_DECLARE_TARGET,
+  PRAGMA_OMP_END,
   PRAGMA_OMP_FLUSH,
   PRAGMA_OMP_FOR,
   PRAGMA_OMP_LOOP,
   PRAGMA_OMP_MASTER,
+  PRAGMA_OMP_METADIRECTIVE,
   PRAGMA_OMP_ORDERED,
   PRAGMA_OMP_PARALLEL,
   PRAGMA_OMP_REQUIRES,
@@ -252,6 +254,7 @@ extern enum cpp_ttype c_lex_with_flags (tree *, location_t *, unsigned char *,
 					int);
 
 extern void c_pp_lookup_pragma (unsigned int, const char **, const char **);
+extern enum pragma_kind c_pp_lookup_pragma_by_name (const char *);
 
 extern GTY(()) tree pragma_extern_prefix;
 
diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c
index b9930d487fd..fa807530ca7 100644
--- a/gcc/c/c-parser.c
+++ b/gcc/c/c-parser.c
@@ -1583,8 +1583,12 @@ enum pragma_context { pragma_external, pragma_struct, pragma_param,
 static bool c_parser_pragma (c_parser *, enum pragma_context, bool *);
 static void c_parser_omp_cancellation_point (c_parser *, enum pragma_context);
 static bool c_parser_omp_target (c_parser *, enum pragma_context, bool *);
+static void c_parser_omp_begin (c_parser *, bool *);
+static void c_parser_omp_end (c_parser *);
 static void c_parser_omp_end_declare_target (c_parser *);
 static void c_parser_omp_declare (c_parser *, enum pragma_context);
+static tree c_parser_omp_metadirective (location_t, c_parser *, char *,
+					omp_clause_mask, tree *, bool *, bool);
 static void c_parser_omp_requires (c_parser *);
 static bool c_parser_omp_ordered (c_parser *, enum pragma_context, bool *);
 static void c_parser_oacc_routine (c_parser *, enum pragma_context);
@@ -12402,8 +12406,12 @@ c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p)
     case PRAGMA_OMP_TARGET:
       return c_parser_omp_target (parser, context, if_p);
 
-    case PRAGMA_OMP_END_DECLARE_TARGET:
-      c_parser_omp_end_declare_target (parser);
+    case PRAGMA_OMP_BEGIN:
+      c_parser_omp_begin (parser, if_p);
+      return false;
+
+    case PRAGMA_OMP_END:
+      c_parser_omp_end (parser);
       return false;
 
     case PRAGMA_OMP_SCAN:
@@ -18195,6 +18203,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
   location_t for_loc;
   bool tiling = false;
   bool inscan = false;
+
   vec<tree, va_gc> *for_block = make_tree_vector ();
 
   for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
@@ -20934,6 +20943,60 @@ c_parser_omp_end_declare_target (c_parser *parser)
     current_omp_declare_target_attribute--;
 }
 
+static void
+c_parser_omp_begin (c_parser *parser, bool *if_p)
+{
+  location_t loc = c_parser_peek_token (parser)->location;
+  c_parser_consume_pragma(parser);
+  if (c_parser_peek_token (parser)->type == CPP_NAME)
+    {
+      const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+
+      if (strcmp (p, "metadirective") == 0)
+	{
+	  char p_name[sizeof "#pragma omp teams distribute parallel for simd"];
+	  omp_clause_mask mask (0);
+
+	  c_parser_consume_token (parser);
+	  c_parser_omp_metadirective (loc, parser, p_name, mask, NULL, if_p,
+				      true);
+	  return;
+	}
+    }
+
+  error_at (loc, "expected %<begin metadirective%>");
+  c_parser_skip_to_pragma_eol (parser);
+}
+
+static void
+c_parser_omp_end (c_parser *parser)
+{
+  location_t loc = c_parser_peek_token (parser)->location;
+
+  if (c_parser_peek_2nd_token (parser)->type == CPP_NAME)
+    {
+      const char *p
+	= IDENTIFIER_POINTER (c_parser_peek_2nd_token (parser)->value);
+
+      if (strcmp (p, "declare") == 0)
+	{
+	  c_parser_omp_end_declare_target (parser);
+	  return;
+	}
+      else if (strcmp (p, "metadirective") == 0)
+	{
+	  /* The pragma 'omp end metadirective' should have been consumed
+	     when processing the metadirective.  */
+	  error_at (loc, "%<#pragma omp end metadirective%> without "
+			 "corresponding %<#pragma omp begin metadirective%>");
+	}
+    }
+  else
+    error_at (loc, "expected %<end declare target%> or %<end metadirective%>");
+
+  c_parser_skip_to_pragma_eol (parser);
+}
+
 
 /* OpenMP 4.0
    #pragma omp declare reduction (reduction-id : typename-list : expression) \
@@ -21607,6 +21670,295 @@ c_parser_omp_taskloop (location_t loc, c_parser *parser,
   return ret;
 }
 
+/* OpenMP 5.0:
+
+  # pragma omp metadirective [clause[, clause]]
+
+  # pragma omp begin metadirective [clause[, clause]]
+  # pragma omp end metadirective
+*/
+
+static tree
+c_parser_omp_metadirective (location_t loc, c_parser *parser,
+			    char *p_name, omp_clause_mask mask, tree *cclauses,
+			    bool *if_p,
+			    bool begin_end_p)
+{
+  tree ret;
+  bool all_selectors_resolveable = true;
+  auto_vec<auto_vec<c_token> > directive_tokens;
+  auto_vec<tree> ctxs;
+  bool default_seen = false;
+
+  ret = make_node (OMP_METADIRECTIVE);
+  SET_EXPR_LOCATION (ret, loc);
+  TREE_TYPE (ret) = void_type_node;
+  OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
+  strcat (p_name, " metadirective");
+
+  while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
+    {
+      if (c_parser_next_token_is_not (parser, CPP_NAME)
+	  && c_parser_next_token_is_not (parser, CPP_KEYWORD))
+	{
+	  c_parser_error (parser, "expected %<when%> or %<default%>");
+	  return NULL_TREE;
+	}
+
+      location_t match_loc = c_parser_peek_token (parser)->location;
+      const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+      c_parser_consume_token (parser);
+      bool default_p = strcmp (p, "default") == 0;
+      if (default_p)
+	{
+	  if (default_seen)
+	    {
+	      c_parser_error (parser, "there can only be one default clause");
+	      return NULL_TREE;
+	    }
+	  else
+	    default_seen = true;
+	}
+      if (strcmp (p, "when") == 0 || default_p)
+	{
+	  matching_parens parens;
+	  tree ctx = NULL_TREE;
+	  bool skip = false;
+	  if (!parens.require_open (parser))
+	    return error_mark_node;
+
+	  if (!default_p)
+	    {
+	      ctx = c_parser_omp_context_selector_specification (parser,
+								 NULL_TREE);
+	      if (ctx == error_mark_node)
+		return NULL_TREE;
+	      ctx = c_omp_check_context_selector (match_loc, ctx);
+	      if (ctx == error_mark_node)
+		return NULL_TREE;
+
+	      switch (omp_context_selector_matches (ctx, true))
+		{
+		case -1:
+		  all_selectors_resolveable = false;
+		  break;
+		case 1:
+		  break;
+		case 0:
+		  /* Remove the selector from further consideration.  */
+		  skip = true;
+		  break;
+		}
+
+	      if (c_parser_next_token_is_not (parser, CPP_COLON))
+		{
+		  c_parser_error (parser, "expected colon");
+		  return NULL_TREE;
+		}
+	      c_parser_consume_token (parser);
+	    }
+
+	  /* Read in the directive type and create a dummy pragma token for
+	     it.  */
+	  c_token *token = c_parser_peek_token (parser);
+	  if (token->type != CPP_NAME)
+	    {
+	      c_parser_error (parser, "expected directive name");
+	      return NULL_TREE;
+	    }
+
+	  location_t loc = c_parser_peek_token (parser)->location;
+	  const char *p
+	    = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+	  enum pragma_kind p_kind = c_pp_lookup_pragma_by_name (p);
+
+	  c_parser_consume_token (parser);
+	  if (p_kind == PRAGMA_NONE)
+	    {
+	      c_parser_error (parser, "unknown directive name");
+	      return NULL_TREE;
+	    }
+
+	  if (!skip)
+	    {
+	      c_token pragma_token;
+	      pragma_token.type = CPP_PRAGMA;
+	      pragma_token.location = loc;
+	      pragma_token.pragma_kind = p_kind;
+
+	      directive_tokens.safe_push (auto_vec<c_token> ());
+	      directive_tokens.last ().safe_push (pragma_token);
+
+	      ctxs.safe_push (ctx);
+	    }
+
+	  /* Read in tokens for the directive clauses.  */
+	  auto_vec<c_token> *tokens = skip ? NULL : &directive_tokens.last ();
+	  int nesting_depth = 0;
+	  while (1)
+	    {
+	      c_token *token = c_parser_peek_token (parser);
+	      switch (token->type)
+		{
+		case CPP_EOF:
+		case CPP_PRAGMA_EOL:
+		  break;
+		case CPP_OPEN_PAREN:
+		  ++nesting_depth;
+		  goto add;
+		case CPP_CLOSE_PAREN:
+		  if (nesting_depth-- == 0)
+		    break;
+		  goto add;
+		default:
+		add:
+		  if (!skip)
+		    tokens->safe_push (*token);
+		  c_parser_consume_token (parser);
+		  continue;
+		}
+	      break;
+	    }
+
+	  c_parser_consume_token (parser);
+
+	  if (!skip)
+	    {
+	      c_token eol_token;
+	      memset (&eol_token, 0, sizeof (eol_token));
+	      eol_token.type = CPP_PRAGMA_EOL;
+	      tokens->safe_push (eol_token);
+	    }
+	}
+      else {
+	c_parser_error (parser, "expected %<when%> or %<default%>");
+	return NULL_TREE;
+      }
+    }
+  c_parser_skip_to_pragma_eol (parser);
+
+  /* Add the body tokens to the tokens for each candidate directive.  */
+  int nesting_depth = 0;
+  int bracket_depth = 0;
+  while (1)
+    {
+      int i;
+      auto_vec<c_token> *tokens;
+      c_token *token = c_parser_peek_token (parser);
+      bool stop = false;
+
+      if (begin_end_p)
+	{
+	  /* Keep reading until '#pragma end metadirective' is read.  */
+	  switch (token->type)
+	  {
+	  case CPP_PRAGMA:
+	    if (token->pragma_kind == PRAGMA_OMP_END)
+	      {
+		c_token *next_token = c_parser_peek_2nd_token (parser);
+		if (next_token->type == CPP_NAME
+		    && strcmp (IDENTIFIER_POINTER (next_token->value),
+			       "metadirective") == 0)
+		  {
+		    c_parser_consume_pragma (parser);
+		    c_parser_consume_token (parser);
+		    c_parser_skip_to_pragma_eol (parser);
+		    break;
+		  }
+	      }
+	  default:
+	    FOR_EACH_VEC_ELT (directive_tokens, i, tokens)
+	      tokens->safe_push (*token);
+	    if (token->type == CPP_PRAGMA)
+	      c_parser_consume_pragma (parser);
+	    else if (token->type == CPP_PRAGMA_EOL)
+	      c_parser_skip_to_pragma_eol (parser);
+	    else
+	      c_parser_consume_token (parser);
+	    continue;
+	  }
+	  break;
+	}
+      else
+	{
+	  switch (token->type)
+	    {
+	    case CPP_EOF:
+	      break;
+	    case CPP_OPEN_BRACE:
+	      ++nesting_depth;
+	      goto add2;
+	    case CPP_CLOSE_BRACE:
+	      if (--nesting_depth == 0)
+		stop = true;
+	      goto add2;
+	    case CPP_OPEN_PAREN:
+	      ++bracket_depth;
+	      goto add2;
+	    case CPP_CLOSE_PAREN:
+	      --bracket_depth;
+	      goto add2;
+	    case CPP_SEMICOLON:
+	      if (nesting_depth == 0 && bracket_depth == 0)
+		stop = true;
+	      goto add2;
+	    default:
+	    add2:
+	      FOR_EACH_VEC_ELT (directive_tokens, i, tokens)
+		tokens->safe_push (*token);
+	      if (token->type == CPP_PRAGMA)
+		c_parser_consume_pragma (parser);
+	      else if (token->type == CPP_PRAGMA_EOL)
+		c_parser_skip_to_pragma_eol (parser);
+	      else
+		c_parser_consume_token (parser);
+	      if (stop)
+		break;
+	      continue;
+	    }
+	  break;
+	}
+    }
+
+  /* Process each candidate directive.  */
+  auto_vec<c_token> *tokens;
+  int i;
+  FOR_EACH_VEC_ELT (directive_tokens, i, tokens)
+    {
+      /* Make sure nothing tries to read past the end of the tokens.  */
+      c_token eof_token;
+      memset (&eof_token, 0, sizeof (eof_token));
+      eof_token.type = CPP_EOF;
+      tokens->safe_push (eof_token);
+      tokens->safe_push (eof_token);
+
+      unsigned int tokens_avail = parser->tokens_avail;
+      gcc_assert (parser->tokens == &parser->tokens_buf[0]);
+      parser->tokens = tokens->address ();
+      parser->tokens_avail = tokens->length ();
+
+      tree block = c_begin_compound_stmt (false);
+      c_parser_omp_construct (parser, if_p);
+      block = c_end_compound_stmt (loc, block, false);
+
+      tree variant = build_tree_list (ctxs[i], block);
+      OMP_METADIRECTIVE_CLAUSES (ret)
+	= chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
+
+      parser->tokens = &parser->tokens_buf[0];
+      parser->tokens_avail = tokens_avail;
+    }
+
+  if (all_selectors_resolveable)
+    {
+      ret = omp_resolve_metadirective (ret);
+      gcc_assert (ret != NULL_TREE);
+    }
+  add_stmt (ret);
+
+  return ret;
+}
+
 /* Main entry point to parsing most OpenMP pragmas.  */
 
 static void
@@ -21676,6 +22028,11 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
       strcpy (p_name, "#pragma omp");
       stmt = c_parser_omp_master (loc, parser, p_name, mask, NULL, if_p);
       break;
+    case PRAGMA_OMP_METADIRECTIVE:
+      strcpy (p_name, "#pragma omp");
+      stmt = c_parser_omp_metadirective (loc, parser, p_name, mask, NULL,
+					 if_p, false);
+      break;
     case PRAGMA_OMP_PARALLEL:
       strcpy (p_name, "#pragma omp");
       stmt = c_parser_omp_parallel (loc, parser, p_name, mask, NULL, if_p);
@@ -21713,7 +22070,6 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
     gcc_assert (EXPR_LOCATION (stmt) != UNKNOWN_LOCATION);
 }
 
-
 /* OpenMP 2.5:
    # pragma omp threadprivate (variable-list) */
 
diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
index f3503b13a5a..e2584c18571 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -43543,6 +43543,32 @@ cp_parser_omp_end_declare_target (cp_parser *parser, cp_token *pragma_tok)
     scope_chain->omp_declare_target_attribute--;
 }
 
+static void
+cp_parser_omp_end (cp_parser *parser, cp_token *pragma_tok)
+{
+  const char *p = "";
+  if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+    {
+      tree id = cp_lexer_peek_token (parser->lexer)->u.value;
+      p = IDENTIFIER_POINTER (id);
+    }
+  if (strcmp (p, "declare") == 0)
+    {
+      cp_parser_omp_end_declare_target (parser, pragma_tok);
+      return;
+    }
+  else if (strcmp (p, "metadirective") == 0)
+    /* The pragma 'omp end metadirective' should have been consumed
+       when processing the metadirective.  */
+    error_at (pragma_tok->location,
+	      "%<#pragma omp end metadirective%> without corresponding "
+	      "%<#pragma omp begin metadirective%>");
+  else
+    error_at (pragma_tok->location,
+	      "expected %<declare target%> or %<metadirective%>");
+  cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+}
+
 /* Helper function of cp_parser_omp_declare_reduction.  Parse the combiner
    expression and optional initializer clause of
    #pragma omp declare reduction.  We store the expression(s) as
@@ -45259,8 +45285,8 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
       pop_omp_privatization_clauses (stmt);
       return ret;
 
-    case PRAGMA_OMP_END_DECLARE_TARGET:
-      cp_parser_omp_end_declare_target (parser, pragma_tok);
+    case PRAGMA_OMP_END:
+      cp_parser_omp_end (parser, pragma_tok);
       return false;
 
     case PRAGMA_OMP_SCAN:
diff --git a/gcc/gimple-low.c b/gcc/gimple-low.c
index fa7d4de30c0..b68b0cbb06c 100644
--- a/gcc/gimple-low.c
+++ b/gcc/gimple-low.c
@@ -234,6 +234,39 @@ lower_omp_directive (gimple_stmt_iterator *gsi, struct lower_data *data)
   gsi_next (gsi);
 }
 
+/* Lower the OpenMP metadirective statement pointed by GSI.  */
+
+static void
+lower_omp_metadirective (gimple_stmt_iterator *gsi, struct lower_data *data)
+{
+  gimple *stmt = gsi_stmt (*gsi);
+  gimple *body = gimple_omp_metadirective_bodies (stmt);
+  tree succ_label = create_artificial_label (UNKNOWN_LOCATION);
+  unsigned i;
+
+  for (i = 0; i < gimple_omp_metadirective_num_clauses (stmt); i++)
+    {
+      tree label = create_artificial_label (UNKNOWN_LOCATION);
+      gimple *g = gimple_build_label (label);
+
+      gsi_insert_after (gsi, g, GSI_CONTINUE_LINKING);
+      lower_sequence (gimple_omp_body_ptr (body), data);
+      gsi_insert_seq_after (gsi, gimple_omp_body (body), GSI_CONTINUE_LINKING);
+      gsi_insert_after (gsi, gimple_build_goto (succ_label),
+			GSI_CONTINUE_LINKING);
+      gimple_omp_metadirective_set_label (stmt, i, label);
+
+      body = body->next;
+    }
+
+  gsi_insert_after (gsi, gimple_build_label (succ_label),
+		    GSI_CONTINUE_LINKING);
+  gimple_omp_metadirective_set_succ_label (stmt, succ_label);
+  gimple_omp_metadirective_set_bodies (stmt, NULL);
+
+  gsi_next (gsi);
+}
+
 
 /* Lower statement GSI.  DATA is passed through the recursion.  We try to
    track the fallthruness of statements and get rid of unreachable return
@@ -398,6 +431,12 @@ lower_stmt (gimple_stmt_iterator *gsi, struct lower_data *data)
       data->cannot_fallthru = false;
       return;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      data->cannot_fallthru = false;
+      lower_omp_metadirective (gsi, data);
+      data->cannot_fallthru = false;
+      return;
+
     case GIMPLE_TRANSACTION:
       lower_sequence (gimple_transaction_body_ptr (
 			as_a <gtransaction *> (stmt)),
diff --git a/gcc/gimple-pretty-print.c b/gcc/gimple-pretty-print.c
index 0ef01e6420b..e7a4ba1171b 100644
--- a/gcc/gimple-pretty-print.c
+++ b/gcc/gimple-pretty-print.c
@@ -1978,6 +1978,64 @@ dump_gimple_omp_return (pretty_printer *buffer, const gimple *gs, int spc,
     }
 }
 
+/* Dump a GIMPLE_OMP_METADIRECTIVE tuple on the pretty_printer BUFFER.  */
+
+static void
+dump_gimple_omp_metadirective (pretty_printer *buffer, const gimple *gs,
+			       int spc, dump_flags_t flags)
+{
+  if (flags & TDF_RAW)
+    {
+      dump_gimple_fmt (buffer, spc, flags, "%G <%+BODY <%S> >", gs,
+		       gimple_omp_body (gs));
+    }
+  else
+    {
+      pp_string (buffer, "#pragma omp metadirective");
+      newline_and_indent (buffer, spc + 2);
+
+      gimple *body = gimple_omp_metadirective_bodies (gs);
+      bool has_bodies_p = body != NULL;
+      unsigned num_clauses = gimple_omp_metadirective_num_clauses (gs);
+
+      for (unsigned i = 0; i < num_clauses; i++)
+	{
+	  tree selector = gimple_omp_metadirective_selector (gs, i);
+
+	  if (selector == NULL_TREE)
+	    pp_string (buffer, "default:");
+	  else
+	    {
+	      pp_string (buffer, "when (");
+	      dump_generic_node (buffer, selector, spc, flags, false);
+	      pp_string (buffer, "):");
+	    }
+
+	  if (has_bodies_p)
+	    {
+	      newline_and_indent (buffer, spc + 4);
+	      pp_left_brace (buffer);
+	      pp_newline (buffer);
+	      dump_gimple_seq (buffer, gimple_omp_body (body), spc + 6, flags);
+	      newline_and_indent (buffer, spc + 4);
+	      pp_right_brace (buffer);
+
+	      body = body->next;
+	      if (body)
+		newline_and_indent (buffer, spc + 2);
+	    }
+	  else
+	    {
+	      tree label = gimple_omp_metadirective_label (gs, i);
+	      pp_string (buffer, " ");
+	      dump_generic_node (buffer, label, spc, flags, false);
+	      if (i != num_clauses - 1)
+		newline_and_indent (buffer, spc + 2);
+	    }
+	}
+    }
+}
+
 /* Dump a GIMPLE_TRANSACTION tuple on the pretty_printer BUFFER.  */
 
 static void
@@ -2729,6 +2787,12 @@ pp_gimple_stmt_1 (pretty_printer *buffer, const gimple *gs, int spc,
 				flags);
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      dump_gimple_omp_metadirective (buffer,
+				     as_a <const gomp_metadirective *> (gs),
+				     spc, flags);
+      break;
+
     case GIMPLE_CATCH:
       dump_gimple_catch (buffer, as_a <const gcatch *> (gs), spc, flags);
       break;
diff --git a/gcc/gimple-streamer-in.c b/gcc/gimple-streamer-in.c
index 1c979f438a5..66bbc2e8e0a 100644
--- a/gcc/gimple-streamer-in.c
+++ b/gcc/gimple-streamer-in.c
@@ -151,6 +151,7 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
     case GIMPLE_COND:
     case GIMPLE_GOTO:
     case GIMPLE_DEBUG:
+    case GIMPLE_OMP_METADIRECTIVE:
       for (i = 0; i < num_ops; i++)
 	{
 	  tree *opp, op = stream_read_tree (ib, data_in);
@@ -188,6 +189,10 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
 	  else
 	    gimple_call_set_fntype (call_stmt, stream_read_tree (ib, data_in));
 	}
+      if (gomp_metadirective *metadirective_stmt
+	    = dyn_cast <gomp_metadirective*> (stmt))
+	gimple_omp_metadirective_set_succ_label (metadirective_stmt,
+						 stream_read_tree (ib, data_in));
       break;
 
     case GIMPLE_NOP:
diff --git a/gcc/gimple-streamer-out.c b/gcc/gimple-streamer-out.c
index fcbf92300d4..f0ddd6a81a3 100644
--- a/gcc/gimple-streamer-out.c
+++ b/gcc/gimple-streamer-out.c
@@ -127,6 +127,7 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
     case GIMPLE_COND:
     case GIMPLE_GOTO:
     case GIMPLE_DEBUG:
+    case GIMPLE_OMP_METADIRECTIVE:
       for (i = 0; i < gimple_num_ops (stmt); i++)
 	{
 	  tree op = gimple_op (stmt, i);
@@ -169,6 +170,8 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
 	  else
 	    stream_write_tree (ob, gimple_call_fntype (stmt), true);
 	}
+      if (gimple_code (stmt) == GIMPLE_OMP_METADIRECTIVE)
+	stream_write_tree (ob, gimple_omp_metadirective_succ_label (stmt), true);
       break;
 
     case GIMPLE_NOP:
diff --git a/gcc/gimple-walk.c b/gcc/gimple-walk.c
index e4a55f1eeb6..ad7e1c0839e 100644
--- a/gcc/gimple-walk.c
+++ b/gcc/gimple-walk.c
@@ -674,6 +674,21 @@ walk_gimple_stmt (gimple_stmt_iterator *gsi, walk_stmt_fn callback_stmt,
 	return wi->callback_result;
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      {
+	gimple *body = gimple_omp_metadirective_bodies (stmt);
+
+	while (body)
+	  {
+	    ret = walk_gimple_seq_mod (gimple_omp_body_ptr (body),
+				       callback_stmt, callback_op, wi);
+	    if (ret)
+	      return wi->callback_result;
+	    body = body->next;
+	  }
+      }
+      break;
+
     case GIMPLE_WITH_CLEANUP_EXPR:
       ret = walk_gimple_seq_mod (gimple_wce_cleanup_ptr (stmt), callback_stmt,
 			     callback_op, wi);
diff --git a/gcc/gimple.c b/gcc/gimple.c
index f1044e9c630..f94009d39f3 100644
--- a/gcc/gimple.c
+++ b/gcc/gimple.c
@@ -1234,6 +1234,28 @@ gimple_build_omp_atomic_store (tree val, enum omp_memory_order mo)
   return p;
 }
 
+/* Build a GIMPLE_OMP_METADIRECTIVE statement.  */
+
+gomp_metadirective *
+gimple_build_omp_metadirective (int clause_count)
+{
+  gomp_metadirective *p
+    = as_a <gomp_metadirective *> (gimple_alloc (GIMPLE_OMP_METADIRECTIVE,
+						 clause_count * 2));
+  gimple_omp_metadirective_set_bodies (p, NULL);
+  return p;
+}
+
+
+gomp_metadirective_body *
+gimple_build_omp_metadirective_body (gimple_seq body)
+{
+  gomp_metadirective_body *m_body = as_a <gomp_metadirective_body *>
+    (gimple_alloc (GIMPLE_OMP_METADIRECTIVE_BODY, 0));
+  gimple_omp_set_body (m_body, body);
+  return m_body;
+}
+
 /* Build a GIMPLE_TRANSACTION statement.  */
 
 gtransaction *
diff --git a/gcc/gimple.def b/gcc/gimple.def
index 0ac0cf72bfa..1da68c16a91 100644
--- a/gcc/gimple.def
+++ b/gcc/gimple.def
@@ -384,6 +384,13 @@ DEFGSCODE(GIMPLE_OMP_TEAMS, "gimple_omp_teams", GSS_OMP_PARALLEL_LAYOUT)
    CLAUSES is an OMP_CLAUSE chain holding the associated clauses.  */
 DEFGSCODE(GIMPLE_OMP_ORDERED, "gimple_omp_ordered", GSS_OMP_SINGLE_LAYOUT)
 
+/* GIMPLE_OMP_METADIRECTIVE represents #pragma omp metadirective.  */
+DEFGSCODE(GIMPLE_OMP_METADIRECTIVE, "gimple_omp_metadirective",
+	  GSS_OMP_METADIRECTIVE)
+
+DEFGSCODE(GIMPLE_OMP_METADIRECTIVE_BODY, "gimple_omp_metadirective_body",
+	  GSS_OMP_METADIRECTIVE_BODY)
+
 /* GIMPLE_PREDICT <PREDICT, OUTCOME> specifies a hint for branch prediction.
 
    PREDICT is one of the predictors from predict.def.
diff --git a/gcc/gimple.h b/gcc/gimple.h
index 91b92b4a4d1..c5288af2bd7 100644
--- a/gcc/gimple.h
+++ b/gcc/gimple.h
@@ -822,6 +822,29 @@ struct GTY((tag("GSS_OMP_ATOMIC_STORE_LAYOUT")))
          stmt->code == GIMPLE_OMP_RETURN.  */
 };
 
+struct GTY((tag("GSS_OMP_METADIRECTIVE_BODY")))
+  gomp_metadirective_body : public gimple_statement_omp_single_layout
+{
+    /* No extra fields; adds invariant:
+       stmt->code == GIMPLE_OMP_METADIRECTIVE_BODY.  */
+};
+
+struct GTY((tag("GSS_OMP_METADIRECTIVE")))
+  gomp_metadirective : public gimple_statement_with_ops_base
+{
+  /* [ WORD 1-7 ] : base class */
+
+  /* [ WORD 8 ]  */
+  gomp_metadirective_body *bodies;
+
+  /* [ WORD 9 ] : a label after the metadirective
+     and all the candidate bodies  */
+  tree succ_label;
+
+  /* [ WORD 10 ] : operand vector.  */
+  tree GTY((length ("%h.num_ops"))) op[1];
+};
+
 /* GIMPLE_TRANSACTION.  */
 
 /* Bits to be stored in the GIMPLE_TRANSACTION subcode.  */
@@ -1233,6 +1256,22 @@ is_a_helper <gomp_task *>::test (gimple *gs)
   return gs->code == GIMPLE_OMP_TASK;
 }
 
+template <>
+template <>
+inline bool
+is_a_helper <gomp_metadirective *>::test (gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_METADIRECTIVE;
+}
+
+template <>
+template <>
+inline bool
+is_a_helper <gomp_metadirective_body *>::test (gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_METADIRECTIVE_BODY;
+}
+
 template <>
 template <>
 inline bool
@@ -1475,6 +1514,22 @@ is_a_helper <const gomp_task *>::test (const gimple *gs)
   return gs->code == GIMPLE_OMP_TASK;
 }
 
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_metadirective *>::test (const gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_METADIRECTIVE;
+}
+
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_metadirective_body *>::test (const gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_METADIRECTIVE_BODY;
+}
+
 template <>
 template <>
 inline bool
@@ -1572,6 +1627,8 @@ gomp_teams *gimple_build_omp_teams (gimple_seq, tree);
 gomp_atomic_load *gimple_build_omp_atomic_load (tree, tree,
 						enum omp_memory_order);
 gomp_atomic_store *gimple_build_omp_atomic_store (tree, enum omp_memory_order);
+gomp_metadirective *gimple_build_omp_metadirective (int clause_count);
+gomp_metadirective_body *gimple_build_omp_metadirective_body (gimple_seq body);
 gtransaction *gimple_build_transaction (gimple_seq);
 extern void gimple_seq_add_stmt (gimple_seq *, gimple *);
 extern void gimple_seq_add_stmt_without_update (gimple_seq *, gimple *);
@@ -1827,6 +1884,7 @@ gimple_has_substatements (gimple *g)
     case GIMPLE_OMP_TARGET:
     case GIMPLE_OMP_TEAMS:
     case GIMPLE_OMP_CRITICAL:
+    case GIMPLE_OMP_METADIRECTIVE:
     case GIMPLE_WITH_CLEANUP_EXPR:
     case GIMPLE_TRANSACTION:
       return true;
@@ -2479,12 +2537,21 @@ gimple_ops (gimple *gs)
 }
 
 
+/* Return true if GIMPLE statement G has any operands, including any that
+   should not be processed by the SSA passes.  */
+
+static inline bool
+gimple_has_ops_1 (const gimple *g)
+{
+  return gimple_has_ops (g) || gimple_code (g) == GIMPLE_OMP_METADIRECTIVE;
+}
+
 /* Return operand I for statement GS.  */
 
 static inline tree
 gimple_op (const gimple *gs, unsigned i)
 {
-  if (gimple_has_ops (gs))
+  if (gimple_has_ops_1 (gs))
     {
       gcc_gimple_checking_assert (i < gimple_num_ops (gs));
       return gimple_ops (CONST_CAST_GIMPLE (gs))[i];
@@ -2498,7 +2565,7 @@ gimple_op (const gimple *gs, unsigned i)
 static inline tree *
 gimple_op_ptr (gimple *gs, unsigned i)
 {
-  if (gimple_has_ops (gs))
+  if (gimple_has_ops_1 (gs))
     {
       gcc_gimple_checking_assert (i < gimple_num_ops (gs));
       return gimple_ops (gs) + i;
@@ -2512,7 +2579,7 @@ gimple_op_ptr (gimple *gs, unsigned i)
 static inline void
 gimple_set_op (gimple *gs, unsigned i, tree op)
 {
-  gcc_gimple_checking_assert (gimple_has_ops (gs) && i < gimple_num_ops (gs));
+  gcc_gimple_checking_assert (gimple_has_ops_1 (gs) && i < gimple_num_ops (gs));
 
   /* Note.  It may be tempting to assert that OP matches
      is_gimple_operand, but that would be wrong.  Different tuples
@@ -6330,6 +6397,77 @@ gimple_omp_continue_set_control_use (gomp_continue *cont_stmt, tree use)
   cont_stmt->control_use = use;
 }
 
+
+static inline tree
+gimple_omp_metadirective_succ_label (const gimple *g)
+{
+  const gomp_metadirective *omp_metadirective
+    = as_a <const gomp_metadirective *> (g);
+  return omp_metadirective->succ_label;
+}
+
+
+static inline void
+gimple_omp_metadirective_set_succ_label (gimple *g, tree succ_label)
+{
+  gomp_metadirective *omp_metadirective = as_a <gomp_metadirective *> (g);
+  omp_metadirective->succ_label = succ_label;
+}
+
+
+static inline gomp_metadirective_body *
+gimple_omp_metadirective_bodies (const gimple *g)
+{
+  const gomp_metadirective *omp_metadirective
+    = as_a <const gomp_metadirective *> (g);
+  return omp_metadirective->bodies;
+}
+
+
+static inline void
+gimple_omp_metadirective_set_bodies (gimple *g,
+				     gomp_metadirective_body *bodies)
+{
+  gomp_metadirective *omp_metadirective = as_a <gomp_metadirective *> (g);
+  omp_metadirective->bodies = bodies;
+}
+
+
+static inline unsigned
+gimple_omp_metadirective_num_clauses (const gimple *g)
+{
+  return gimple_num_ops (g) / 2;
+}
+
+
+static inline tree
+gimple_omp_metadirective_selector (const gimple *g, unsigned n)
+{
+  return gimple_op (g, n * 2);
+}
+
+
+static inline void
+gimple_omp_metadirective_set_selector (gimple *g, unsigned n, tree selector)
+{
+  return gimple_set_op (g, n * 2, selector);
+}
+
+
+static inline tree
+gimple_omp_metadirective_label (const gimple *g, unsigned n)
+{
+  return gimple_op (g, n * 2 + 1);
+}
+
+
+static inline void
+gimple_omp_metadirective_set_label (gimple *g, unsigned n, tree label)
+{
+  return gimple_set_op (g, n * 2 + 1, label);
+}
+
+
 /* Return a pointer to the body for the GIMPLE_TRANSACTION statement
    TRANSACTION_STMT.  */
 
@@ -6478,6 +6616,7 @@ gimple_return_set_retval (greturn *gs, tree retval)
     case GIMPLE_OMP_RETURN:			\
     case GIMPLE_OMP_ATOMIC_LOAD:		\
     case GIMPLE_OMP_ATOMIC_STORE:		\
+    case GIMPLE_OMP_METADIRECTIVE:		\
     case GIMPLE_OMP_CONTINUE
 
 static inline bool
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index 2730f225187..49f4bcb01f3 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -5646,6 +5646,7 @@ is_gimple_stmt (tree t)
     case OMP_TASKGROUP:
     case OMP_ORDERED:
     case OMP_CRITICAL:
+    case OMP_METADIRECTIVE:
     case OMP_TASK:
     case OMP_TARGET:
     case OMP_TARGET_DATA:
@@ -13785,6 +13786,49 @@ gimplify_omp_ordered (tree expr, gimple_seq body)
   return gimple_build_omp_ordered (body, OMP_ORDERED_CLAUSES (expr));
 }
 
+static enum gimplify_status
+gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
+			    bool (*gimple_test_f) (tree), fallback_t fallback)
+{
+  gomp_metadirective_body *first_body = NULL;
+  gomp_metadirective_body *prev_body = NULL;
+  auto_vec<tree> selectors;
+  unsigned i;
+  tree clause = OMP_METADIRECTIVE_CLAUSES (*expr_p);
+
+  while (clause)
+    {
+      tree selector = TREE_PURPOSE (clause);
+      tree directive = TREE_VALUE (clause);
+
+      selectors.safe_push (selector);
+      gomp_metadirective_body *body
+	= gimple_build_omp_metadirective_body (NULL);
+      gimplify_stmt (&directive, gimple_omp_body_ptr (body));
+      if (!first_body)
+	first_body = body;
+      if (prev_body)
+	{
+	  prev_body->next = body;
+	  body->prev = prev_body;
+	}
+      prev_body = body;
+
+      clause = TREE_CHAIN (clause);
+    }
+
+  gomp_metadirective *stmt
+    = gimple_build_omp_metadirective (selectors.length ());
+  gimple_omp_metadirective_set_bodies (stmt, first_body);
+  gimplify_seq_add_stmt (pre_p, stmt);
+
+  tree selector;
+  FOR_EACH_VEC_ELT (selectors, i, selector)
+    gimple_omp_metadirective_set_selector (stmt, i, selector);
+
+  return GS_ALL_DONE;
+}
+
 /* Convert the GENERIC expression tree *EXPR_P to GIMPLE.  If the
    expression produces a value to be used as an operand inside a GIMPLE
    statement, the value will be stored back in *EXPR_P.  This value will
@@ -14680,6 +14724,11 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
 	  ret = gimplify_omp_atomic (expr_p, pre_p);
 	  break;
 
+	case OMP_METADIRECTIVE:
+	  ret = gimplify_omp_metadirective (expr_p, pre_p, post_p,
+					    gimple_test_f, fallback);
+	  break;
+
 	case TRANSACTION_EXPR:
 	  ret = gimplify_transaction (expr_p, pre_p);
 	  break;
diff --git a/gcc/gsstruct.def b/gcc/gsstruct.def
index 8f777e2bb95..f22ac1f65cb 100644
--- a/gcc/gsstruct.def
+++ b/gcc/gsstruct.def
@@ -50,4 +50,6 @@ DEFGSSTRUCT(GSS_OMP_SINGLE_LAYOUT, gimple_statement_omp_single_layout, false)
 DEFGSSTRUCT(GSS_OMP_CONTINUE, gomp_continue, false)
 DEFGSSTRUCT(GSS_OMP_ATOMIC_LOAD, gomp_atomic_load, false)
 DEFGSSTRUCT(GSS_OMP_ATOMIC_STORE_LAYOUT, gomp_atomic_store, false)
+DEFGSSTRUCT(GSS_OMP_METADIRECTIVE, gomp_metadirective, true)
+DEFGSSTRUCT(GSS_OMP_METADIRECTIVE_BODY, gomp_metadirective_body, false)
 DEFGSSTRUCT(GSS_TRANSACTION, gtransaction, false)
diff --git a/gcc/omp-expand-metadirective.cc b/gcc/omp-expand-metadirective.cc
new file mode 100644
index 00000000000..f4620df577a
--- /dev/null
+++ b/gcc/omp-expand-metadirective.cc
@@ -0,0 +1,125 @@
+/* Expand an OpenMP metadirective.
+
+   Copyright (C) 2021 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "backend.h"
+#include "target.h"
+#include "tree.h"
+#include "langhooks.h"
+#include "gimple.h"
+#include "tree-pass.h"
+#include "cgraph.h"
+#include "fold-const.h"
+#include "gimplify.h"
+#include "gimple-iterator.h"
+#include "gimple-walk.h"
+#include "gomp-constants.h"
+#include "omp-general.h"
+#include "diagnostic-core.h"
+#include "tree-cfg.h"
+#include "cfganal.h"
+
+static void
+omp_expand_metadirective (function *fun, basic_block bb)
+{
+  gimple *stmt = last_stmt (bb);
+  tree selected_label = omp_resolve_metadirective (stmt);
+
+  /* This is the last chance for the metadirective to be resolved.  */
+  if (!selected_label)
+    gcc_unreachable ();
+
+  /* Delete all variant BBs except for the selected one.  */
+  calculate_dominance_info (CDI_DOMINATORS);
+  for (unsigned i = 0; i < gimple_omp_metadirective_num_clauses (stmt); i++)
+    {
+      tree label = gimple_omp_metadirective_label (stmt, i);
+      edge edge = find_edge (bb, label_to_block (fun, label));
+      if (label == selected_label)
+	edge->flags |= EDGE_FALLTHRU;
+      else
+	remove_edge_and_dominated_blocks (edge);
+    }
+
+  /* Remove the metadirective statement.  */
+  gimple_stmt_iterator gsi = gsi_last_bb (bb);
+  gsi_remove (&gsi, true);
+}
+
+namespace {
+
+const pass_data pass_data_omp_expand_metadirective =
+{
+  GIMPLE_PASS, /* type */
+  "omp_expand_metadirective", /* name */
+  OPTGROUP_OMP, /* optinfo_flags */
+  TV_NONE, /* tv_id */
+  PROP_gimple_lcf, /* properties_required */
+  0, /* properties_provided */
+  0, /* properties_destroyed */
+  0, /* todo_flags_start */
+  0, /* todo_flags_finish */
+};
+
+class pass_omp_expand_metadirective : public gimple_opt_pass
+{
+public:
+  pass_omp_expand_metadirective (gcc::context *ctxt)
+    : gimple_opt_pass (pass_data_omp_expand_metadirective, ctxt)
+  {}
+
+  /* opt_pass methods: */
+  virtual bool gate (function *)
+  {
+    return (flag_openmp);
+  }
+
+  virtual unsigned int execute (function *fun);
+}; // class pass_omp_oacc_kernels_decompose
+
+unsigned int
+pass_omp_expand_metadirective::execute (function *fun)
+{
+  basic_block bb;
+  auto_vec<basic_block> metadirective_bbs;
+
+  FOR_EACH_BB_FN (bb, fun)
+    {
+      gimple *stmt = last_stmt (bb);
+      if (stmt && is_a<gomp_metadirective *> (stmt))
+	metadirective_bbs.safe_push (bb);
+    }
+
+  for (unsigned i = 0; i < metadirective_bbs.length (); i++)
+    omp_expand_metadirective (fun, metadirective_bbs[i]);
+
+  return 0;
+}
+
+} // anon namespace
+
+
+gimple_opt_pass *
+make_pass_omp_expand_metadirective (gcc::context *ctxt)
+{
+  return new pass_omp_expand_metadirective (ctxt);
+}
diff --git a/gcc/omp-expand.c b/gcc/omp-expand.c
index 0f843bad79a..2c1affb64f8 100644
--- a/gcc/omp-expand.c
+++ b/gcc/omp-expand.c
@@ -9866,6 +9866,22 @@ expand_omp_target (struct omp_region *region)
     }
 }
 
+static void
+expand_omp_metadirective (struct omp_region *region)
+{
+  gomp_metadirective *stmt
+    = as_a <gomp_metadirective *> (last_stmt (region->entry));
+  tree succ_label = gimple_omp_metadirective_succ_label (stmt);
+  basic_block succ_bb = label_to_block (cfun, succ_label);
+  gimple_stmt_iterator gsi = gsi_start_bb (succ_bb);
+  while (!gsi_end_p (gsi)
+	 && gimple_code (gsi_stmt (gsi)) != GIMPLE_OMP_RETURN)
+    gsi_next (&gsi);
+
+  gcc_assert (gimple_code (gsi_stmt (gsi)) == GIMPLE_OMP_RETURN);
+  gsi_remove (&gsi, true);
+}
+
 /* Expand the parallel region tree rooted at REGION.  Expansion
    proceeds in depth-first order.  Innermost regions are expanded
    first.  This way, parallel regions that require a new function to
@@ -9952,6 +9968,10 @@ expand_omp (struct omp_region *region)
 	  expand_omp_target (region);
 	  break;
 
+	case GIMPLE_OMP_METADIRECTIVE:
+	  expand_omp_metadirective (region);
+	  break;
+
 	default:
 	  gcc_unreachable ();
 	}
@@ -10388,6 +10408,24 @@ omp_make_gimple_edges (basic_block bb, struct omp_region **region,
 	}
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      /* Create an edge to the beginning of the body of each candidate
+	 directive.  */
+      {
+	unsigned i;
+	cur_region = new_omp_region (bb, code, cur_region);
+	gimple *stmt = last_stmt (bb);
+	for (i = 0; i < gimple_omp_metadirective_num_clauses (stmt); i++)
+	  {
+	    tree dest = gimple_omp_metadirective_label (stmt, i);
+	    basic_block dest_bb = label_to_block (cfun, dest);
+	    make_edge (bb, dest_bb, 0);
+	  }
+
+	fallthru = false;
+      }
+      break;
+
     default:
       gcc_unreachable ();
     }
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index a1bb9d8d25d..4839a9849bc 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -44,6 +44,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "tree-iterator.h"
 #include "data-streamer.h"
 #include "streamer-hooks.h"
+#include "tree-pretty-print.h"
 
 enum omp_requires omp_requires_mask;
 
@@ -1100,8 +1101,13 @@ omp_context_name_list_prop (tree prop)
    others need to wait until the whole TU is parsed, others need to wait until
    IPA, others until vectorization.  */
 
+#define DELAY_METADIRECTIVES_AFTER_LTO { \
+  if (metadirective_p && !(cfun->curr_properties & PROP_gimple_lomp_dev))	\
+    return -1;	\
+}
+
 int
-omp_context_selector_matches (tree ctx)
+omp_context_selector_matches (tree ctx, bool metadirective_p)
 {
   int ret = 1;
   for (tree t1 = ctx; t1; t1 = TREE_CHAIN (t1))
@@ -1222,6 +1228,8 @@ omp_context_selector_matches (tree ctx)
 		    const char *arch = omp_context_name_list_prop (t3);
 		    if (arch == NULL)
 		      return 0;
+		    DELAY_METADIRECTIVES_AFTER_LTO;
+
 		    int r = 0;
 		    if (targetm.omp.device_kind_arch_isa != NULL)
 		      r = targetm.omp.device_kind_arch_isa (omp_device_arch,
@@ -1340,6 +1348,8 @@ omp_context_selector_matches (tree ctx)
 			  return 0;
 			continue;
 		      }
+		    DELAY_METADIRECTIVES_AFTER_LTO;
+
 		    int r = 0;
 		    if (targetm.omp.device_kind_arch_isa != NULL)
 		      r = targetm.omp.device_kind_arch_isa (omp_device_kind,
@@ -1379,6 +1389,8 @@ omp_context_selector_matches (tree ctx)
 		    const char *isa = omp_context_name_list_prop (t3);
 		    if (isa == NULL)
 		      return 0;
+		    DELAY_METADIRECTIVES_AFTER_LTO;
+
 		    int r = 0;
 		    if (targetm.omp.device_kind_arch_isa != NULL)
 		      r = targetm.omp.device_kind_arch_isa (omp_device_isa,
@@ -1445,6 +1457,8 @@ omp_context_selector_matches (tree ctx)
   return ret;
 }
 
+#undef DELAY_METADIRECTIVES_AFTER_LTO
+
 /* Compare construct={simd} CLAUSES1 with CLAUSES2, return 0/-1/1/2 as
    in omp_context_selector_set_compare.  */
 
@@ -2459,6 +2473,161 @@ omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
 						 INSERT) = entryp;
 }
 
+tree
+omp_resolve_metadirective (tree metadirective)
+{
+  auto_vec <tree, 16> clauses;
+  auto_vec <widest_int, 16> scores;
+  tree clause = OMP_METADIRECTIVE_CLAUSES (metadirective);
+  tree default_variant = NULL_TREE;
+
+  while (clause)
+    {
+      tree selector = TREE_PURPOSE (clause);
+      widest_int score;
+
+      if (selector == NULL_TREE)
+	default_variant = TREE_VALUE (clause);
+      else
+	switch (omp_context_selector_matches (selector, true))
+	  {
+	  case -1:
+	    return NULL_TREE;
+	  case 1:
+	    clauses.safe_push (clause);
+	    /* TODO: Handle SIMD score?  */
+	    omp_context_compute_score (selector, &score, false);
+	    scores.safe_push (score);
+	    break;
+	  case 0:
+	    break;
+	  }
+      clause = TREE_CHAIN (clause);
+    }
+
+  /* TODO: Handle case where there is no default.  */
+  if (clauses.is_empty ())
+    {
+      if (dump_file)
+	fprintf (dump_file, "Selecting default directive variant\n");
+      return default_variant;
+    }
+
+  /* A context selector that is a strict subset of another context selector
+     has a score of zero.  */
+  tree clause1, clause2;
+  unsigned int i, j;
+  FOR_EACH_VEC_ELT (clauses, i, clause1)
+    FOR_EACH_VEC_ELT_FROM (clauses, j, clause2, i + 1)
+      {
+	int r = omp_context_selector_compare (TREE_PURPOSE (clause1),
+					      TREE_PURPOSE (clause2));
+	if (r == -1)
+	  {
+	    /* ctx1 is a strict subset of ctx2.  */
+	    scores[i] = 0;
+	    break;
+	  }
+	else if (r == 1)
+	  /* ctx2 is a strict subset of ctx1.  */
+	  scores[j] = 0;
+      }
+
+  widest_int score, highest_score = -1;
+  FOR_EACH_VEC_ELT (scores, i, score)
+    if (score > highest_score)
+      {
+	highest_score = score;
+	clause = clauses[i];
+      }
+
+  if (dump_file)
+    {
+      fprintf (dump_file, "Selecting directive variant with selector:");
+      print_generic_expr (dump_file, TREE_PURPOSE (clause));
+      fprintf (dump_file, "\n");
+    }
+  return TREE_VALUE (clause);
+}
+
+tree
+omp_resolve_metadirective (gimple *gs)
+{
+  auto_vec <tree, 16> labels;
+  auto_vec <tree, 16> selectors;
+  auto_vec <widest_int, 16> scores;
+  tree default_label = gimple_omp_metadirective_succ_label (gs);
+
+  for (unsigned i = 0; i < gimple_omp_metadirective_num_clauses (gs); i++)
+    {
+      tree selector = gimple_omp_metadirective_selector (gs, i);
+      widest_int score;
+      if (selector == NULL_TREE)
+	default_label = gimple_omp_metadirective_label (gs, i);
+      else
+	switch (omp_context_selector_matches (selector, true))
+	  {
+	  case -1:
+	    return NULL;
+	  case 1:
+	    labels.safe_push (gimple_omp_metadirective_label (gs, i));
+	    selectors.safe_push (selector);
+	    /* TODO: Handle SIMD score?.  */
+	    omp_context_compute_score (selector, &score, false);
+	    scores.safe_push (score);
+	    break;
+	  case 0:
+	    break;
+	  }
+    }
+
+  if (scores.is_empty ())
+    {
+      if (dump_file)
+	fprintf (dump_file, "Selecting default directive variant\n");
+      return default_label;
+    }
+
+  /* A context selector that is a strict subset of another context selector
+     has a score of zero.  */
+  tree ctx1, ctx2;
+  unsigned int i, j;
+  FOR_EACH_VEC_ELT (selectors, i, ctx1)
+    FOR_EACH_VEC_ELT_FROM (selectors, j, ctx2, i + 1)
+      {
+	int r = omp_context_selector_compare (ctx1, ctx2);
+	if (r == -1)
+	  {
+	    /* ctx1 is a strict subset of ctx2.  */
+	    scores[i] = 0;
+	    break;
+	  }
+	else if (r == 1)
+	  /* ctx2 is a strict subset of ctx1.  */
+	  scores[j] = 0;
+      }
+
+  unsigned highest_index = 0;
+  widest_int score, highest_score = -1;
+  FOR_EACH_VEC_ELT (scores, i, score)
+  {
+    if (score > highest_score)
+      {
+	highest_score = score;
+	highest_index = i;
+      }
+  }
+
+  if (dump_file)
+    {
+      fprintf (dump_file, "Selecting directive variant with selector:");
+      print_generic_expr (dump_file, selectors[highest_index]);
+      fprintf (dump_file, "\n");
+    }
+
+  return labels[highest_index];
+}
+
 /* Encode an oacc launch argument.  This matches the GOMP_LAUNCH_PACK
    macro on gomp-constants.h.  We do not check for overflow.  */
 
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index aa04895e16d..47cea2eae01 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -104,10 +104,12 @@ extern tree find_combined_omp_for (tree *, int *, void *);
 extern poly_uint64 omp_max_vf (void);
 extern int omp_max_simt_vf (void);
 extern int omp_constructor_traits_to_codes (tree, enum tree_code *);
-extern int omp_context_selector_matches (tree);
+extern int omp_context_selector_matches (tree, bool = false);
 extern int omp_context_selector_set_compare (const char *, tree, tree);
 extern tree omp_get_context_selector (tree, const char *, const char *);
 extern tree omp_resolve_declare_variant (tree);
+extern tree omp_resolve_metadirective (tree);
+extern tree omp_resolve_metadirective (gimple *);
 extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
 extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
 extern void oacc_replace_fn_attrib (tree fn, tree dims);
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index d1136d181b3..c54000cfb9d 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -179,6 +179,10 @@ struct omp_context
   /* Only used for omp target contexts.  True if an OpenMP construct other
      than teams is strictly nested in it.  */
   bool nonteams_nested_p;
+
+  /* Only used for omp metadirectives.  Links to the next shallow
+     clone of this context.  */
+  struct omp_context *next_clone;
 };
 
 static splay_tree all_contexts;
@@ -964,6 +968,7 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
   splay_tree_insert (all_contexts, (splay_tree_key) stmt,
 		     (splay_tree_value) ctx);
   ctx->stmt = stmt;
+  ctx->next_clone = NULL;
 
   if (outer_ctx)
     {
@@ -993,6 +998,17 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
   return ctx;
 }
 
+static omp_context *
+clone_omp_context (omp_context *ctx)
+{
+  omp_context *clone_ctx = XCNEW (omp_context);
+
+  memcpy (clone_ctx, ctx, sizeof (omp_context));
+  ctx->next_clone = clone_ctx;
+
+  return clone_ctx;
+}
+
 static gimple_seq maybe_catch_exception (gimple_seq);
 
 /* Finalize task copyfn.  */
@@ -1039,6 +1055,14 @@ delete_omp_context (splay_tree_value value)
 {
   omp_context *ctx = (omp_context *) value;
 
+  /* Delete clones.  */
+  omp_context *clone = ctx->next_clone;
+  while (clone)
+    {
+      clone = clone->next_clone;
+      XDELETE (clone);
+    }
+
   delete ctx->cb.decl_map;
 
   if (ctx->field_map)
@@ -1073,6 +1097,7 @@ delete_omp_context (splay_tree_value value)
   delete ctx->lastprivate_conditional_map;
   delete ctx->allocate_map;
 
+
   XDELETE (ctx);
 }
 
@@ -3008,6 +3033,23 @@ scan_omp_teams (gomp_teams *stmt, omp_context *outer_ctx)
     ctx->record_type = ctx->receiver_decl = NULL;
 }
 
+/* Scan an OpenMP metadirective.  */
+
+static void
+scan_omp_metadirective (gomp_metadirective *stmt, omp_context *outer_ctx)
+{
+  gomp_metadirective_body *body = gimple_omp_metadirective_bodies (stmt);
+
+  while (body)
+    {
+      gimple_seq *body_p = gimple_omp_body_ptr (body);
+      omp_context *ctx = outer_ctx ? clone_omp_context (outer_ctx) : NULL;
+      scan_omp (body_p, ctx);
+
+      body = (gomp_metadirective_body *) body->next;
+    }
+}
+
 /* Check nesting restrictions.  */
 static bool
 check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx)
@@ -4045,6 +4087,10 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
 	scan_omp_teams (as_a <gomp_teams *> (stmt), ctx);
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      scan_omp_metadirective (as_a <gomp_metadirective *> (stmt), ctx);
+      break;
+
     case GIMPLE_BIND:
       {
 	tree var;
@@ -10129,6 +10175,22 @@ lower_omp_for_lastprivate (struct omp_for_data *fd, gimple_seq *body_p,
     }
 }
 
+static void
+lower_omp_metadirective (gimple_stmt_iterator *gsi_p, omp_context *ctx)
+{
+  gimple *stmt = gsi_stmt (*gsi_p);
+  gomp_metadirective_body *body = gimple_omp_metadirective_bodies (stmt);
+  while (body)
+    {
+      gimple_seq *body_p = gimple_omp_body_ptr (body);
+      omp_context *ctx = maybe_lookup_ctx (*body_p);
+      lower_omp (body_p, ctx);
+      body = (gomp_metadirective_body *) (body->next);
+    }
+  gsi_insert_after (gsi_p, gimple_build_omp_return (true),
+		    GSI_CONTINUE_LINKING);
+}
+
 /* Callback for walk_gimple_seq.  Find #pragma omp scan statement.  */
 
 static tree
@@ -13474,6 +13536,9 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx)
       else
 	lower_omp_teams (gsi_p, ctx);
       break;
+    case GIMPLE_OMP_METADIRECTIVE:
+      lower_omp_metadirective (gsi_p, ctx);
+      break;
     case GIMPLE_CALL:
       tree fndecl;
       call_stmt = as_a <gcall *> (stmt);
diff --git a/gcc/passes.def b/gcc/passes.def
index 945d2bc797c..9aad498f266 100644
--- a/gcc/passes.def
+++ b/gcc/passes.def
@@ -186,6 +186,7 @@ along with GCC; see the file COPYING3.  If not see
   NEXT_PASS (pass_oacc_device_lower);
   NEXT_PASS (pass_omp_device_lower);
   NEXT_PASS (pass_omp_target_link);
+  NEXT_PASS (pass_omp_expand_metadirective);
   NEXT_PASS (pass_adjust_alignment);
   NEXT_PASS (pass_all_optimizations);
   PUSH_INSERT_PASSES_WITHIN (pass_all_optimizations)
diff --git a/gcc/tree-cfg.c b/gcc/tree-cfg.c
index 02256580c98..525e945a2d7 100644
--- a/gcc/tree-cfg.c
+++ b/gcc/tree-cfg.c
@@ -1668,6 +1668,23 @@ cleanup_dead_labels (void)
 	  }
 	  break;
 
+	case GIMPLE_OMP_METADIRECTIVE:
+	  {
+	    int i;
+	    for (i = 0; i < gimple_omp_metadirective_num_clauses (stmt); i++)
+	      {
+		label = gimple_omp_metadirective_label (stmt, i);
+		new_label = main_block_label (label, label_for_bb);
+		if (new_label != label)
+		  gimple_omp_metadirective_set_label (stmt, i, new_label);
+	      }
+	    label = gimple_omp_metadirective_succ_label (stmt);
+	    new_label = main_block_label (label, label_for_bb);
+	    if (new_label != label)
+	      gimple_omp_metadirective_set_succ_label (stmt, new_label);
+	  }
+	  break;
+
 	default:
 	  break;
       }
@@ -6078,6 +6095,22 @@ gimple_redirect_edge_and_branch (edge e, basic_block dest)
 				           gimple_block_label (dest));
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      {
+	for (unsigned i = 0; i < gimple_omp_metadirective_num_clauses (stmt); i++)
+	  {
+	    tree label = gimple_omp_metadirective_label (stmt, i);
+	    if (label_to_block (cfun, label) == e->dest)
+	      gimple_omp_metadirective_set_label (stmt, i,
+						  gimple_block_label (dest));
+	  }
+	tree label = gimple_omp_metadirective_succ_label (stmt);
+	if (label_to_block (cfun, label) == e->dest)
+	  gimple_omp_metadirective_set_succ_label (stmt,
+						   gimple_block_label (dest));
+      }
+      break;
+
     default:
       /* Otherwise it must be a fallthru edge, and we don't need to
 	 do anything besides redirecting it.  */
diff --git a/gcc/tree-inline.c b/gcc/tree-inline.c
index 8f945b88c12..3a21268b93b 100644
--- a/gcc/tree-inline.c
+++ b/gcc/tree-inline.c
@@ -4534,6 +4534,12 @@ estimate_num_insns (gimple *stmt, eni_weights *weights)
       return (weights->omp_cost
               + estimate_num_insns_seq (gimple_omp_body (stmt), weights));
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      /* The actual instruction will disappear eventually, so metadirective
+	 statements have zero cost.  */
+      gcc_assert (gimple_omp_body (stmt) == NULL);
+      return 0;
+
     case GIMPLE_TRANSACTION:
       return (weights->tm_cost
 	      + estimate_num_insns_seq (gimple_transaction_body (
diff --git a/gcc/tree-pass.h b/gcc/tree-pass.h
index 15693fee150..c02dda89f6a 100644
--- a/gcc/tree-pass.h
+++ b/gcc/tree-pass.h
@@ -418,6 +418,7 @@ extern gimple_opt_pass *make_pass_lower_switch_O0 (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_lower_vector (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_lower_vector_ssa (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_omp_oacc_kernels_decompose (gcc::context *ctxt);
+extern gimple_opt_pass *make_pass_omp_expand_metadirective (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_lower_omp (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_diagnose_omp_blocks (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_expand_omp (gcc::context *ctxt);
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index 0a575eb9dad..5b601a303c6 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -3626,6 +3626,34 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
       is_expr = false;
       break;
 
+    case OMP_METADIRECTIVE:
+      {
+	pp_string (pp, "#pragma omp metadirective");
+	newline_and_indent (pp, spc + 2);
+	pp_left_brace (pp);
+
+	tree clause = OMP_METADIRECTIVE_CLAUSES (node);
+	while (clause != NULL_TREE)
+	  {
+	    newline_and_indent (pp, spc + 4);
+	    if (TREE_PURPOSE (clause) == NULL_TREE)
+	      pp_string (pp, "default:");
+	    else
+	      {
+		pp_string (pp, "when (");
+		dump_generic_node (pp, TREE_PURPOSE (clause), spc + 4, flags,
+				   false);
+		pp_string (pp, "):");
+	      }
+	    newline_and_indent (pp, spc + 6);
+	    dump_generic_node (pp, TREE_VALUE (clause), spc + 6, flags, false);
+	    clause = TREE_CHAIN (clause);
+	  }
+	newline_and_indent (pp, spc + 2);
+	pp_right_brace (pp);
+      }
+      break;
+
     case TRANSACTION_EXPR:
       if (TRANSACTION_EXPR_OUTER (node))
 	pp_string (pp, "__transaction_atomic [[outer]]");
diff --git a/gcc/tree-ssa-operands.c b/gcc/tree-ssa-operands.c
index c15575416dd..ee26451d717 100644
--- a/gcc/tree-ssa-operands.c
+++ b/gcc/tree-ssa-operands.c
@@ -978,6 +978,9 @@ operands_scanner::parse_ssa_operands ()
       append_vuse (gimple_vop (fn));
       goto do_default;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      break;
+
     case GIMPLE_CALL:
       /* Add call-clobbered operands, if needed.  */
       maybe_add_call_vops (as_a <gcall *> (stmt));
diff --git a/gcc/tree.def b/gcc/tree.def
index eda050bdc55..9d50c739539 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1264,6 +1264,11 @@ DEFTREECODE (OMP_TARGET_ENTER_DATA, "omp_target_enter_data", tcc_statement, 1)
    Operand 0: OMP_TARGET_EXIT_DATA_CLAUSES: List of clauses.  */
 DEFTREECODE (OMP_TARGET_EXIT_DATA, "omp_target_exit_data", tcc_statement, 1)
 
+/* OpenMP - #pragma omp metadirective [clause1 ... clauseN]
+   Operand 0: OMP_METADIRECTIVE_CLAUSES: List of selectors and directive
+	variants.  */
+DEFTREECODE (OMP_METADIRECTIVE, "omp_metadirective", tcc_statement, 1)
+
 /* OMP_ATOMIC through OMP_ATOMIC_CAPTURE_NEW must be consecutive,
    or OMP_ATOMIC_SEQ_CST needs adjusting.  */
 
diff --git a/gcc/tree.h b/gcc/tree.h
index 64612cfa368..0d74cc75ce1 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1459,6 +1459,9 @@ class auto_suppress_location_wrappers
 #define OMP_TARGET_EXIT_DATA_CLAUSES(NODE)\
   TREE_OPERAND (OMP_TARGET_EXIT_DATA_CHECK (NODE), 0)
 
+#define OMP_METADIRECTIVE_CLAUSES(NODE) \
+  TREE_OPERAND (OMP_METADIRECTIVE_CHECK (NODE), 0)
+
 #define OMP_SCAN_BODY(NODE)	TREE_OPERAND (OMP_SCAN_CHECK (NODE), 0)
 #define OMP_SCAN_CLAUSES(NODE)	TREE_OPERAND (OMP_SCAN_CHECK (NODE), 1)
 

Re: [WIP, OpenMP] OpenMP metadirectives support

[Kwok Cheung Yeung]

Ping? Does anyone have any opinions on how this issue should be resolved?

On 09/07/2021 12:16 pm, Kwok Cheung Yeung wrote:
> 3) In the OpenMP examples (version 5.0.1), section 9.7, the example 
> metadirective.3.c does not work as expected.
> 
> #pragma omp declare target
> void exp_pi_diff(double *d, double my_pi){
>     #pragma omp metadirective \
>                 when( construct={target}: distribute parallel for ) \
>                 default( parallel for simd)
> ...
> int main()
> {
>     ...
>     #pragma omp target teams map(tofrom: d[0:N])
>     exp_pi_diff(d,my_pi);
>     ...
>     exp_pi_diff(d,my_pi);
> 
> In the first call to exp_pi_diff in an '#pragma omp target' construct, the 
> metadirective is expected to expand to 'distribute parallel for', but in the 
> second (without the '#pragma omp target'), it should expand to 'parallel for simd'.
> 
> During OMP expansion of the 'omp target', it creates a child function that calls 
> exp_pi_diff:
> 
> __attribute__((omp target entrypoint))
> void main._omp_fn.0 (const struct .omp_data_t.12 & restrict .omp_data_i)
> {
>    ...
>    <bb 4> :
>    __builtin_GOMP_teams (0, 0);
>    exp_pi_diff (d.13, my_pi);
> 
> This is not a problem on the offload compiler (since by definition its copy of 
> exp_pi_diff must be in a 'target'), but if the host device is used, the same 
> version of exp_pi_diff is called in both target and non-target contexts.
> 
> What would be the best way to solve this? Offhand, I can think of two solutions:
> 
> (a) Recursively go through all functions that can be reached via a target region 
> and create clones for each, redirecting all function calls in the clones to the 
> new cloned versions. Resolve the metadirectives in the clones and originals 
> separately.
> 

Maybe this could be done at the same time as when marking functions implicitly 
'declare target'? It seems a lot of work for one special case though...

> (b) Make the construct selector a dynamic selector when OpenMP 5.1 metadirective 
> support is implemented. Keep track of the current construct list every time an 
> OpenMP construct is entered or exited, and make the decision at runtime.
> 

I think this would be easier to implement at runtime (assuming that the 
infrastructure for OpenMP 5.1 was already in place) since this a host-side 
issue, but it probably goes against the intent of the specification, given that 
the 'construct' selector set appeared in the 5.0 specification before dynamic 
replacements became available.

Thanks

Kwok

Re: [WIP, OpenMP] OpenMP metadirectives support

[Jakub Jelinek]

On Fri, Jul 09, 2021 at 12:16:15PM +0100, Kwok Cheung Yeung wrote:
> This is a WIP implementation of metadirectives as defined in the OpenMP 5.0
> spec. I intend to add support for metadirectives as specified in OpenMP 5.1
> later (where the directive can be selected dynamically at runtime), but am
> concentrating on the static part for now. Parsing has only been implemented
> in the C frontend so far. I am especially interested in feedback regarding
> certain aspects of the implementation before I become too committed to the
> current design.

Note, there is a partial overlap with the attribute syntax changes, see below.
c-family/c-omp.c now has omp_directives table that should be updated for
changes like this and then c_omp_categorize_directive that returns some
information about the directives given a directive name (though, that name
can be one, two or three tokens long, consider e.g. target enter data
or cancellation point directives).

For metadirective, I think very special case are declarative directives in
them, I'd tend to sorry for them at least for now, I'm pretty sure many
cases with them are just unimplementable and will need to be restricted in
the standard, others can be implemented with lots of effort.
Whether it is e.g. metadirective guarding declare target ... end declare
target pair that would only conditionally set declare target and instead of
a single bit to find out if something is declare target or not we'd until
resolved need to compute it for all possibilities, or e.g. conditional
declare reduction/declare mapper where the name lookup for reduction or map
directives would be dependent on metadirective resolution later on, etc.
I'm afraid a total nightmare nobody has really thought about details for it.

> 1) When parsing each directive variant, a vector of tokens is constructed
> and populated with the tokens for a regular equivalent pragma, along with
> the tokens for its clauses and the body. The parser routine for that pragma
> type is then called with these tokens, and the entire resulting parse tree
> is stored as a sub-tree of the metadirective tree structure.
> 
> This results in the body being parsed and stored once for each directive
> variant. I believe this is necessary because the body is parsed differently
> if there is a 'for' in the directive (using c_parser_omp_for_loop) compared
> to if there is not, plus clauses in the directive (e.g. tile, collapse) can
> change how the for loop is parsed.
> 
> As an optimisation, identical body trees could be merged together, but that
> can come later.

I'm afraid it isn't just an optimization and we need to be as smart as
possible.  I'm not sure it is possible to parse everything many times,
consider e.g. labels in the blocks, nested function definitions, variable
definitions, etc.
While OpenMP requires that essentially the code must be valid if the
metadirective is replaced by any of those mentioned directives which rules
quite some weirdo corner cases, nothing prevents e.g. two or more
when directives to be standalone directives (which don't have any body and
so whatever comes after them should be left parsed for later as normal
statement sequence), one or more to be normal constructs that accept a
structured block and one or more to be e.g. looping constructs (simd, for,
distribute, taskloop or combined versions of those).
Even when issues with labels etc. are somehow solved (e.g. for structured
blocks we have the restriction that goto, break, continue, or switch into
a case/default label, etc. can't be used to enter or exit the structured
block which could mean some cases can be handled through renaming seen
labels in all but one bodies), most important is to sync on where parsing
should continue after the metadirective.
I think it would be nice if the metadirective parsing at least made quick
analysis on what kind of bodies the directives will want and can use the new
c-omp.c infrastructure or if needed extend it (e.g. separate the C_OMP_DIR_CONSTRUCT
category into C_OMP_DIR_CONSTRUCT and C_OMP_DIR_LOOPING_CONSTRUCT where
the latter would be used for those that expect some omp loop after it).
One option would be then to parse the body as the most restricted construct
(looping (and determine highest needed collapse and ordered), then construct,
then standalone) and be able to adjust what we parsed into what the
different constructs need, but another option is the separate parsing of
the code after the directive multiple times, but at least in the order of
most restricted to least restricted, remember where to stop and don't parse
it multiple times at least for directives that need the same thing.

> 
> 2) Selectors in the device set (i.e. kind, isa, arch) resolve differently
> depending on whether the program is running on a target or on the host.
> Since we don't keep multiple versions of a function for each target on the
> host compiler, resolving metadirectives with these selectors needs to be
> delayed until after LTO streaming, at which point the host or offload
> compiler can make the appropriate decision.

How is this different from declare variant?  For declare variant, it is true
I'm never trying to resolve it already during parsing of the call and that
probably should be changed, do a first attempt at that point.  Initially
I thought it typically will not be possible, but later clarification and
strong desire of LLVM/ICC etc. to do everything or almost everything already
during parsing suggests that it must be doable at least in some cases.
E.g. we have restrictions that requires directive on which some decision
could be dependent must appear only lexically before it or not at all, etc.
So, similarly to that, metadirective ideally should see if something is
impossible already during parsing (dunno if it should mean we wouldn't parse
the body in that case, that would mean worse diagnostics), then repeat the
checks during gimplification like declare variant is resolved there, then
repeat again after IPA.  Would be probably best if for metadirectives that
resolve to executable directives we represent it by something like a magic
IFN that is told everything needed to decide and can share as much code as
possible with the declare variant decisions.

It is true other compilers implement offloading quite differently from GCC,
by repeating all of preprocessing, parsing etc. for the offloading target,
so they can decide some metadirective/declare variant decisions earlier than
we can.  On the other side that approach has also quite some disadvantages,
it is much harder to ensure ABI compatibility between the host and offload
code if one can use #ifdefs and whatever to change layout of everything in
between.

For the checks during parsing, we'll need a different way how to track which
directives are currently active (or defer anything with construct
selectors till gimplification).  It is true that resolving that during
parsing goes against the goal to parse as many bodies together as possible,
so we need to pick one or the other.  Parsing what follows for all
standalone directives isn't a problem of course, but if the metadirective
has one when with for and another with simd, then parsing the loop just once
would be a problem if there is metadirective in the body that wants to
decide whether it is in for or simd and wants that decision be done during
parsing.

> One negative of this is that the metadirective Gimple representation lasts
> beyond the OMP expand stage, when generally we would expect all OMP
> directives to have been expanded to something else.
> 
> 3) In the OpenMP examples (version 5.0.1), section 9.7, the example
> metadirective.3.c does not work as expected.
> 
> #pragma omp declare target
> void exp_pi_diff(double *d, double my_pi){
>    #pragma omp metadirective \
>                when( construct={target}: distribute parallel for ) \
>                default( parallel for simd)
> ...
> int main()
> {
>    ...
>    #pragma omp target teams map(tofrom: d[0:N])
>    exp_pi_diff(d,my_pi);
>    ...
>    exp_pi_diff(d,my_pi);

The spec says in this case that the target construct is added to the
construct set because of the function appearing in between omp declare target
and omp end declare target, so the above is something that resolves
statically to distribute parallel for.
It is true that in OpenMP 5.1 the earlier
For functions within a declare target block, the target trait is added to the beginning of the
set as c 1 for any versions of the function that are generated for target regions so the total size
of the set is increased by 1.
has been mistakenly replaced with:
For device routines, the target trait is added to the beginning of the set as c 1 for any versions of
the procedure that are generated for target regions so the total size of the set is increased by 1.
by that has been corrected in 5.2:
C/C++:
For functions that are declared in a code region that is delimited by a declare target directive and
its paired end directive, the target trait is added to the beginning of the set as c 1 for any target
variants that result from the directive so the total size of the set is increased by one.
Fortran:
If a declare target directive appears in the specification part of a procedure or in the
specification part of a procedure interface body, the target trait is added to the beginning of the
set as c 1 for any target variants that result from the directive so the total size of the set is
increased by one.

So, it is really a static decision that can be decided already during
parsing.
> --- a/gcc/Makefile.in
> +++ b/gcc/Makefile.in
> @@ -1505,6 +1505,7 @@ OBJS = \
>  	omp-general.o \
>  	omp-low.o \
>  	omp-oacc-kernels-decompose.o \
> +        omp-expand-metadirective.o \

Spaces instead of tab.

> @@ -1312,12 +1312,14 @@ static const struct omp_pragma_def omp_pragmas[] = {
>    { "allocate", PRAGMA_OMP_ALLOCATE },
>    { "atomic", PRAGMA_OMP_ATOMIC },
>    { "barrier", PRAGMA_OMP_BARRIER },
> +  { "begin", PRAGMA_OMP_BEGIN },
>    { "cancel", PRAGMA_OMP_CANCEL },
>    { "cancellation", PRAGMA_OMP_CANCELLATION_POINT },
>    { "critical", PRAGMA_OMP_CRITICAL },
>    { "depobj", PRAGMA_OMP_DEPOBJ },
> -  { "end", PRAGMA_OMP_END_DECLARE_TARGET },
> +  { "end", PRAGMA_OMP_END },
>    { "flush", PRAGMA_OMP_FLUSH },
> +  { "metadirective", PRAGMA_OMP_METADIRECTIVE },
>    { "requires", PRAGMA_OMP_REQUIRES },
>    { "section", PRAGMA_OMP_SECTION },
>    { "sections", PRAGMA_OMP_SECTIONS },

Please update for this also the omp_directives array.

> +enum pragma_kind
> +c_pp_lookup_pragma_by_name (const char *name)
> +{
> +  const int n_omp_pragmas = sizeof (omp_pragmas) / sizeof (*omp_pragmas);
> +  const int n_omp_pragmas_simd = sizeof (omp_pragmas_simd)
> +				 / sizeof (*omp_pragmas_simd);
> +
> +  void *result = bsearch (name, omp_pragmas, n_omp_pragmas,
> +			  sizeof (*omp_pragmas),
> +			  c_pp_lookup_pragma_by_name_1);
> +  if (!result)
> +    result = bsearch (name, omp_pragmas_simd, n_omp_pragmas_simd,
> +		      sizeof (*omp_pragmas_simd),
> +		      c_pp_lookup_pragma_by_name_1);
> +
> +  if (result)
> +    {
> +      const struct omp_pragma_def *def
> +	= (const struct omp_pragma_def *) result;
> +
> +      return (enum pragma_kind) def->id;
> +    }
> +
> +  return PRAGMA_NONE;
> +}

I think this should be dropped and c_omp_categorize_directive should
be used instead of it.

Please add a function comment to show the grammar.  See e.g.
c_parser_omp_declare.

>  
> +static void
> +c_parser_omp_begin (c_parser *parser, bool *if_p)
> +{
> +  location_t loc = c_parser_peek_token (parser)->location;
> +  c_parser_consume_pragma(parser);

Space before (.

> +  if (c_parser_peek_token (parser)->type == CPP_NAME)
> +    {
> +      const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
> +
> +      if (strcmp (p, "metadirective") == 0)
> +	{
> +	  char p_name[sizeof "#pragma omp teams distribute parallel for simd"];
> +	  omp_clause_mask mask (0);
> +
> +	  c_parser_consume_token (parser);
> +	  c_parser_omp_metadirective (loc, parser, p_name, mask, NULL, if_p,
> +				      true);

metadirective, by not being itself combinable, doesn't need this p_name
and mask stuff.  That is used only for combined/composite construct when
the p_name and mask need to be computed dynamically based on the exact
parsing.  The begin metadirective vs. metadirective difference is a boolean
one that can be either passed as bool, or if the pragma token is passed
one could look at its pragma kind.

> +	  return;
> +	}
> +    }
> +
> +  error_at (loc, "expected %<begin metadirective%>");

"expected %<metadirective%>" ?  #pragma omp begin already appeared...

> +  c_parser_skip_to_pragma_eol (parser);
> +}
> +
> +static void
> +c_parser_omp_end (c_parser *parser)

Similarly with the function comment.

	Jakub

Re: [WIP, OpenMP] OpenMP metadirectives support

[Kwok Cheung Yeung]

Hello

Thanks for your reply.

On 26/07/2021 3:29 pm, Jakub Jelinek wrote:
> On Fri, Jul 09, 2021 at 12:16:15PM +0100, Kwok Cheung Yeung wrote:
>> 3) In the OpenMP examples (version 5.0.1), section 9.7, the example
>> metadirective.3.c does not work as expected.
>>
>> #pragma omp declare target
>> void exp_pi_diff(double *d, double my_pi){
>>     #pragma omp metadirective \
>>                 when( construct={target}: distribute parallel for ) \
>>                 default( parallel for simd)
>> ...
>> int main()
>> {
>>     ...
>>     #pragma omp target teams map(tofrom: d[0:N])
>>     exp_pi_diff(d,my_pi);
>>     ...
>>     exp_pi_diff(d,my_pi);
> 
> The spec says in this case that the target construct is added to the
> construct set because of the function appearing in between omp declare target
> and omp end declare target, so the above is something that resolves
> statically to distribute parallel for.
> It is true that in OpenMP 5.1 the earlier
> For functions within a declare target block, the target trait is added to the beginning of the
> set as c 1 for any versions of the function that are generated for target regions so the total size
> of the set is increased by 1.
> has been mistakenly replaced with:
> For device routines, the target trait is added to the beginning of the set as c 1 for any versions of
> the procedure that are generated for target regions so the total size of the set is increased by 1.
> by that has been corrected in 5.2:
> C/C++:
> For functions that are declared in a code region that is delimited by a declare target directive and
> its paired end directive, the target trait is added to the beginning of the set as c 1 for any target
> variants that result from the directive so the total size of the set is increased by one.
> Fortran:
> If a declare target directive appears in the specification part of a procedure or in the
> specification part of a procedure interface body, the target trait is added to the beginning of the
> set as c 1 for any target variants that result from the directive so the total size of the set is
> increased by one.
> 
> So, it is really a static decision that can be decided already during
> parsing.

In Section 1.2.2 of the OpenMP TR10 spec, 'target variant' is defined as:

A version of a device routine that can only be executed as part of a target region.

So isn't this really saying the same thing as the previous versions of the spec? 
The target trait is added to the beginning of the construct set _for any target 
variants_ that result from the directive (implying that it shouldn't be added 
for non-target variants). In this example, the same function exp_pi_diff is 
being used in both a target and non-target context, so shouldn't the 
metadirective resolve differently in the two contexts, independently of the 
function being declared in a 'declare target' block? If not, there does not seem 
to be much point in that example (in section 9.7 of the OpenMP Examples v5.0.1).

 From reading the spec, I infer that they expect the device and non-device 
versions of a function with 'declare target' to be separate, but that is not 
currently the case for GCC - on the host compiler, the same version of the 
function gets called in both target and non-target regions (though in the target 
region case, it gets called indirectly via a compiler-generated function with a 
name like main._omp_fn.0). The offload compiler gets its own streamed version, 
so there is no conflict there - by definition, its version must be in a target 
context.

Thanks,

Kwok

Re: [WIP, OpenMP] OpenMP metadirectives support

[Jakub Jelinek]

On Mon, Jul 26, 2021 at 08:28:16PM +0100, Kwok Cheung Yeung wrote:
> In Section 1.2.2 of the OpenMP TR10 spec, 'target variant' is defined as:
> 
> A version of a device routine that can only be executed as part of a target region.

Yes, that is a target variant, but I'm pretty sure we've decided that
the target construct added for declare target is actually not a dynamic
property.  So basically mostly return to the 5.0 wording with clarifications
for Fortran.  See
https://github.com/OpenMP/spec/issues/2612#issuecomment-849742988
for details.
Making the target in construct dynamic would pretty much force all the
scoring to be dynamic as well.

	Jakub

Re: [WIP, OpenMP] OpenMP metadirectives support

[Kwok Cheung Yeung]

Hello

On 26/07/2021 8:56 pm, Jakub Jelinek wrote:
> On Mon, Jul 26, 2021 at 08:28:16PM +0100, Kwok Cheung Yeung wrote:
>> In Section 1.2.2 of the OpenMP TR10 spec, 'target variant' is defined as:
>>
>> A version of a device routine that can only be executed as part of a target region.
> 
> Yes, that is a target variant, but I'm pretty sure we've decided that
> the target construct added for declare target is actually not a dynamic
> property.  So basically mostly return to the 5.0 wording with clarifications
> for Fortran.  See
> https://github.com/OpenMP/spec/issues/2612#issuecomment-849742988
> for details.
> Making the target in construct dynamic would pretty much force all the
> scoring to be dynamic as well.

In that comment, Deepak says:

So, we decided to keep the target trait static, requiring that the declare 
target directive must be explicit and that the function version must be 
different from the version of the function that may be called outside of a 
target region (with the additional clarification that whether it differs or not 
will be implementation defined).

"the function version must be different from the version of the function that 
may be called outside of a target region": This is what we do not have in GCC at 
the moment - the function versions called within and outside target regions are 
the same on the host.

"whether it differs or not will be implementation defined": So whether a 
function with 'declare target' and a metadirective involving a 'target' 
construct behaves the same or not when called from both inside and outside of a 
target region is implementation defined?

I will leave the treatment of target constructs in the selector as it is then, 
with both calls going to the same function with the metadirective resolving to 
the 'target' variant. I will try to address your other concerns later.

Thanks

Kwok

Re: [WIP, OpenMP] OpenMP metadirectives support

[Jakub Jelinek]

On Mon, Jul 26, 2021 at 10:19:35PM +0100, Kwok Cheung Yeung wrote:
> > Yes, that is a target variant, but I'm pretty sure we've decided that
> > the target construct added for declare target is actually not a dynamic
> > property.  So basically mostly return to the 5.0 wording with clarifications
> > for Fortran.  See
> > https://github.com/OpenMP/spec/issues/2612#issuecomment-849742988
> > for details.
> > Making the target in construct dynamic would pretty much force all the
> > scoring to be dynamic as well.
> 
> In that comment, Deepak says:
> 
> So, we decided to keep the target trait static, requiring that the declare
> target directive must be explicit and that the function version must be
> different from the version of the function that may be called outside of a
> target region (with the additional clarification that whether it differs or
> not will be implementation defined).
> 
> "the function version must be different from the version of the function
> that may be called outside of a target region": This is what we do not have
> in GCC at the moment - the function versions called within and outside
> target regions are the same on the host.
> 
> "whether it differs or not will be implementation defined": So whether a
> function with 'declare target' and a metadirective involving a 'target'
> construct behaves the same or not when called from both inside and outside
> of a target region is implementation defined?
> 
> I will leave the treatment of target constructs in the selector as it is
> then, with both calls going to the same function with the metadirective
> resolving to the 'target' variant. I will try to address your other concerns
> later.

I think you're right, it should differ in the host vs. target version iff
it is in explicit declare target block, my memory is weak, but let's implement
the 5.0 wording for now (and ignore the 5.1 wording later on) and only when
we'll be doing 5.2 change this (and change for both metadirective and
declare variant at that point).
Ok?

	Jakub

Re: [WIP, OpenMP] OpenMP metadirectives support

[Kwok Cheung Yeung]

On 26/07/2021 10:23 pm, Jakub Jelinek wrote:
> On Mon, Jul 26, 2021 at 10:19:35PM +0100, Kwok Cheung Yeung wrote:
>> In that comment, Deepak says:
>>
>> So, we decided to keep the target trait static, requiring that the declare
>> target directive must be explicit and that the function version must be
>> different from the version of the function that may be called outside of a
>> target region (with the additional clarification that whether it differs or
>> not will be implementation defined).
>>
>> "the function version must be different from the version of the function
>> that may be called outside of a target region": This is what we do not have
>> in GCC at the moment - the function versions called within and outside
>> target regions are the same on the host.
>>
>> "whether it differs or not will be implementation defined": So whether a
>> function with 'declare target' and a metadirective involving a 'target'
>> construct behaves the same or not when called from both inside and outside
>> of a target region is implementation defined?
>>
>> I will leave the treatment of target constructs in the selector as it is
>> then, with both calls going to the same function with the metadirective
>> resolving to the 'target' variant. I will try to address your other concerns
>> later.
> 
> I think you're right, it should differ in the host vs. target version iff
> it is in explicit declare target block, my memory is weak, but let's implement
> the 5.0 wording for now (and ignore the 5.1 wording later on) and only when
> we'll be doing 5.2 change this (and change for both metadirective and
> declare variant at that point).
> Ok?
> 

Okay, the rest of the metadirective spec is quite enough to be getting on with 
for now. :-)

Thanks

Kwok

[PATCH] openmp: Add warning when functions containing metadirectives with 'construct={target}' called directly

[Kwok Cheung Yeung]

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

Hello

Regarding this issue which we discussed previously - I have created a 
patch that adds a warning when this situation is detected.

When a metadirective in a explicitly marked target function is 
gimplified, it is checked to see if it contains a 'construct={target}' 
selector - if it does, then the containing function is marked with 'omp 
metadirective construct target'.

In the omp-low pass, when function calls are processed, the target 
function is checked to see if it contains the marker. If it does and the 
call is not made in a target context, a warning is emitted.

This will obviously not catch every possible occurence (e.g. if the 
function containing the metadirective is called from another target 
function which is then called locally, or if the call is made via a 
function pointer), but it might still be useful? Okay for mainline (once 
the metadirective patches are done)?

Thanks

Kwok

On 26/07/2021 10:23 pm, Jakub Jelinek wrote:
> On Mon, Jul 26, 2021 at 10:19:35PM +0100, Kwok Cheung Yeung wrote:
>>> Yes, that is a target variant, but I'm pretty sure we've decided that
>>> the target construct added for declare target is actually not a dynamic
>>> property.  So basically mostly return to the 5.0 wording with clarifications
>>> for Fortran.  See
>>> https://github.com/OpenMP/spec/issues/2612#issuecomment-849742988
>>> for details.
>>> Making the target in construct dynamic would pretty much force all the
>>> scoring to be dynamic as well.
>>
>> In that comment, Deepak says:
>>
>> So, we decided to keep the target trait static, requiring that the declare
>> target directive must be explicit and that the function version must be
>> different from the version of the function that may be called outside of a
>> target region (with the additional clarification that whether it differs or
>> not will be implementation defined).
>>
>> "the function version must be different from the version of the function
>> that may be called outside of a target region": This is what we do not have
>> in GCC at the moment - the function versions called within and outside
>> target regions are the same on the host.
>>
>> "whether it differs or not will be implementation defined": So whether a
>> function with 'declare target' and a metadirective involving a 'target'
>> construct behaves the same or not when called from both inside and outside
>> of a target region is implementation defined?
>>
>> I will leave the treatment of target constructs in the selector as it is
>> then, with both calls going to the same function with the metadirective
>> resolving to the 'target' variant. I will try to address your other concerns
>> later.
> 
> I think you're right, it should differ in the host vs. target version iff
> it is in explicit declare target block, my memory is weak, but let's implement
> the 5.0 wording for now (and ignore the 5.1 wording later on) and only when
> we'll be doing 5.2 change this (and change for both metadirective and
> declare variant at that point).
> Ok?
> 
> 	Jakub
> 

[-- Attachment #2: 0001-openmp-Add-warning-when-functions-containing-metadir.patch --]
[-- Type: text/plain, Size: 8613 bytes --]

From 741b037a8cd6b85d43a6273ab305ce07705dfa23 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 28 Jan 2022 13:56:33 +0000
Subject: [PATCH] openmp: Add warning when functions containing metadirectives
 with 'construct={target}' called directly

void f(void)
{
  #pragma omp metadirective \
    when (construct={target}: A) \
    default (B)
    ...
}
...
{
  #pragma omp target
    f(); // Target call

  f(); // Local call
}

With the OpenMP 5.0/5.1 specifications, we would expect A to be selected in
the metadirective when the target call is made, but B when f is called
directly outside of a target context.  However, since GCC does not have
separate copies of f for local and target calls, and the construct selector
is static, it must be resolved one way or the other at compile-time (currently
in the favour of selecting A), which may be unexpected behaviour.

This patch attempts to detect the above situation, and will emit a warning
if found.

2022-01-28  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* gimplify.cc (gimplify_omp_metadirective): Mark offloadable functions
	containing metadirectives with 'construct={target}' in the selector.
	* omp-general.cc (omp_has_target_constructor_p): New.
	* omp-general.h (omp_has_target_constructor_p): New prototype.
	* omp-low.cc (lower_omp_1): Emit warning if marked functions called
	outside of a target context.

	gcc/testsuite/
	* c-c++-common/gomp/metadirective-4.c (main): Add expected warning.
	* gfortran.dg/gomp/metadirective-4.f90 (test): Likewise.

	libgomp/
	* testsuite/libgomp.c-c++-common/metadirective-2.c (main): Add
	expected warning.
	* testsuite/libgomp.fortran/metadirective-2.f90 (test): Likewise.
---
 gcc/gimplify.cc                               | 21 +++++++++++++++++++
 gcc/omp-general.cc                            | 21 +++++++++++++++++++
 gcc/omp-general.h                             |  1 +
 gcc/omp-low.cc                                | 18 ++++++++++++++++
 .../c-c++-common/gomp/metadirective-4.c       |  2 +-
 .../gfortran.dg/gomp/metadirective-4.f90      |  2 +-
 .../libgomp.c-c++-common/metadirective-2.c    |  2 +-
 .../libgomp.fortran/metadirective-2.f90       |  2 +-
 8 files changed, 65 insertions(+), 4 deletions(-)

diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 78bae567ae4..c8a01a4ca52 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -14775,6 +14775,27 @@ gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *,
 {
   auto_vec<tree> selectors;
 
+  /* Mark offloadable functions containing metadirectives that specify
+     a 'construct' selector with a 'target' constructor.  */
+  if (offloading_function_p (current_function_decl))
+    {
+      for (tree clause = OMP_METADIRECTIVE_CLAUSES (*expr_p);
+	   clause != NULL_TREE; clause = TREE_CHAIN (clause))
+	{
+	  tree selector = TREE_PURPOSE (clause);
+
+	  if (omp_has_target_constructor_p (selector))
+	    {
+	      tree id = get_identifier ("omp metadirective construct target");
+
+	      DECL_ATTRIBUTES (current_function_decl)
+		= tree_cons (id, NULL_TREE,
+			     DECL_ATTRIBUTES (current_function_decl));
+	      break;
+	    }
+	}
+    }
+
   /* Try to resolve the metadirective.  */
   vec<struct omp_metadirective_variant> candidates
     = omp_resolve_metadirective (*expr_p);
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 4edeb58cc73..842e9fd868f 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -2922,6 +2922,27 @@ omp_resolve_metadirective (gimple *gs)
   return omp_get_dynamic_candidates (variants);
 }
 
+bool
+omp_has_target_constructor_p (tree selector)
+{
+  if (selector == NULL_TREE)
+    return false;
+
+  tree selector_set = TREE_PURPOSE (selector);
+  if (strcmp (IDENTIFIER_POINTER (selector_set), "construct") != 0)
+    return false;
+
+  enum tree_code constructs[5];
+  int nconstructs
+    = omp_constructor_traits_to_codes (TREE_VALUE (selector), constructs);
+
+  for (int i = 0; i < nconstructs; i++)
+    if (constructs[i] == OMP_TARGET)
+      return true;
+
+  return false;
+}
+
 /* Encode an oacc launch argument.  This matches the GOMP_LAUNCH_PACK
    macro on gomp-constants.h.  We do not check for overflow.  */
 
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index fdde4a3dfb0..ccdea015e15 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -126,6 +126,7 @@ extern tree omp_get_context_selector (tree, const char *, const char *);
 extern tree omp_resolve_declare_variant (tree);
 extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (tree);
 extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (gimple *);
+extern bool omp_has_target_constructor_p (tree);
 extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
 extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
 extern void oacc_replace_fn_attrib (tree fn, tree dims);
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index 59804300c28..07613362ef0 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -14300,6 +14300,24 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx)
       tree fndecl;
       call_stmt = as_a <gcall *> (stmt);
       fndecl = gimple_call_fndecl (call_stmt);
+      if (fndecl
+	  && lookup_attribute ("omp metadirective construct target",
+			       DECL_ATTRIBUTES (fndecl)))
+	{
+	  bool in_target_ctx = false;
+
+	  for (omp_context *up = ctx; up; up = up->outer)
+	    if (gimple_code (up->stmt) == GIMPLE_OMP_TARGET)
+	      {
+		in_target_ctx = true;
+		break;
+	      }
+	  if (!ctx || !in_target_ctx)
+	    warning_at (gimple_location (stmt), 0,
+			"direct calls to an offloadable function containing "
+			"metadirectives with a %<construct={target}%> "
+			"selector may produce unexpected results");
+	}
       if (fndecl
 	  && fndecl_built_in_p (fndecl, BUILT_IN_NORMAL))
 	switch (DECL_FUNCTION_CODE (fndecl))
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-4.c b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
index c4b109295db..25efbe046bf 100644
--- a/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
@@ -25,7 +25,7 @@ void f(double a[], double x) {
 
   /* TODO: This does not execute a version of f with the default clause
      active as might be expected.  */
-  f (a, 2.71828);
+  f (a, 2.71828); /* { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" } */
 
   return 0;
  }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
index b82c9ea96d9..65eb05cd2fb 100644
--- a/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
@@ -13,7 +13,7 @@ program test
 
   ! TODO: This does not execute a version of f with the default clause
   ! active as might be expected.
-  call f (a, 2.71828)
+  call f (a, 2.71828) ! { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" }
 contains
   subroutine f (a, x)
     integer :: i
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
index cd5c6c5e21a..55a6098e525 100644
--- a/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
@@ -31,7 +31,7 @@ void f(double a[], double x) {
 
   /* TODO: This does not execute a version of f with the default clause
      active as might be expected.  */
-  f (a, M_E);
+  f (a, M_E); /* { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" } */
 
   for (i = 0; i < N; i++)
     if (fabs (a[i] - (M_E * i)) > EPSILON)
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-2.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
index 32017a00077..d83474cf2db 100644
--- a/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
@@ -19,7 +19,7 @@ program test
 
   ! TODO: This does not execute a version of f with the default clause
   ! active as might be expected.
-  call f (a, E_CONST)
+  call f (a, E_CONST) ! { dg-warning "direct calls to an offloadable function containing metadirectives with a 'construct={target}' selector may produce unexpected results" }
 
   do i = 1, N
     if (abs (a(i) - (E_CONST * i)) .gt. EPSILON) stop 2
-- 
2.25.1

Re: [WIP, OpenMP] OpenMP metadirectives support

[Kwok Cheung Yeung]

Hello

It has been several months since I posted my WIP patch, and my current 
patch set (which I will post separately) has evolved considerably since 
then. I have added C++ and Fortran support, as well as dynamic selectors 
from the OpenMP 5.1 spec (currently only the 'user={condition(<expr>)}' 
selector is implemented, target_device is TBD).

On 26/07/2021 3:29 pm, Jakub Jelinek wrote:
> Note, there is a partial overlap with the attribute syntax changes, see below.
> c-family/c-omp.c now has omp_directives table that should be updated for
> changes like this and then c_omp_categorize_directive that returns some
> information about the directives given a directive name (though, that name
> can be one, two or three tokens long, consider e.g. target enter data
> or cancellation point directives).

I have modified the C/C++ parser code to lookup the type of the 
directive using c_omp_categorize_directive.

> For metadirective, I think very special case are declarative directives in
> them, I'd tend to sorry for them at least for now, I'm pretty sure many
> cases with them are just unimplementable and will need to be restricted in
> the standard, others can be implemented with lots of effort.
> Whether it is e.g. metadirective guarding declare target ... end declare
> target pair that would only conditionally set declare target and instead of
> a single bit to find out if something is declare target or not we'd until
> resolved need to compute it for all possibilities, or e.g. conditional
> declare reduction/declare mapper where the name lookup for reduction or map
> directives would be dependent on metadirective resolution later on, etc.
> I'm afraid a total nightmare nobody has really thought about details for it.

The parsers currently emit a sorry if a C_OMP_DIR_DECLARATIVE directive 
is encountered in a metadirective, though I am sure there are many 
remaining ways that one could break it!

>> As an optimisation, identical body trees could be merged together, but that
>> can come later.
> 
> I'm afraid it isn't just an optimization and we need to be as smart as
> possible.  I'm not sure it is possible to parse everything many times,
> consider e.g. labels in the blocks, nested function definitions, variable
> definitions, etc.
> While OpenMP requires that essentially the code must be valid if the
> metadirective is replaced by any of those mentioned directives which rules
> quite some weirdo corner cases, nothing prevents e.g. two or more
> when directives to be standalone directives (which don't have any body and
> so whatever comes after them should be left parsed for later as normal
> statement sequence), one or more to be normal constructs that accept a
> structured block and one or more to be e.g. looping constructs (simd, for,
> distribute, taskloop or combined versions of those).
> Even when issues with labels etc. are somehow solved (e.g. for structured
> blocks we have the restriction that goto, break, continue, or switch into
> a case/default label, etc. can't be used to enter or exit the structured
> block which could mean some cases can be handled through renaming seen
> labels in all but one bodies), most important is to sync on where parsing
> should continue after the metadirective.
> I think it would be nice if the metadirective parsing at least made quick
> analysis on what kind of bodies the directives will want and can use the new
> c-omp.c infrastructure or if needed extend it (e.g. separate the C_OMP_DIR_CONSTRUCT
> category into C_OMP_DIR_CONSTRUCT and C_OMP_DIR_LOOPING_CONSTRUCT where
> the latter would be used for those that expect some omp loop after it).
> One option would be then to parse the body as the most restricted construct
> (looping (and determine highest needed collapse and ordered), then construct,
> then standalone) and be able to adjust what we parsed into what the
> different constructs need, but another option is the separate parsing of
> the code after the directive multiple times, but at least in the order of
> most restricted to least restricted, remember where to stop and don't parse
> it multiple times at least for directives that need the same thing.
>

After some experimentation, I'm not sure if it is possible in the 
general case to share bodies between variants. For one thing, it 
complicates the OMP region outlining and lowering, and becomes rather 
invasive to implement in the parser. Another is the possibility of 
having metadirectives nested within metadirective bodies. e.g. Something 
of the form:

#pragma omp metadirective \
     when (cond1: dir1) \
     when (cond2: dir2)
   {
     #pragma omp metadirective \
       when (construct dir1: dirA)
       when (construct dir2: dirB)
         (body)
   }

in which case the way the inner metadirective is resolved depends on the 
outer metadirective, leading to different bodies.

In my current patch set, I have implemented a limited form of statement 
body sharing when the body is not part of an OMP directive (e.g. an 'omp 
flush' followed by the body). Variables declarations and local functions 
in the body are handled by the usual scoping rules, and labels are 
handled by declaring them as __local__ (C and C++) or by renaming 
(Fortran). I have also added assertions in the parsers to ensure that 
each variant stops parsing at the same point. Would you find this 
acceptable?

>> 2) Selectors in the device set (i.e. kind, isa, arch) resolve differently
>> depending on whether the program is running on a target or on the host.
>> Since we don't keep multiple versions of a function for each target on the
>> host compiler, resolving metadirectives with these selectors needs to be
>> delayed until after LTO streaming, at which point the host or offload
>> compiler can make the appropriate decision.
> 
> How is this different from declare variant?  For declare variant, it is true
> I'm never trying to resolve it already during parsing of the call and that
> probably should be changed, do a first attempt at that point.  Initially
> I thought it typically will not be possible, but later clarification and
> strong desire of LLVM/ICC etc. to do everything or almost everything already
> during parsing suggests that it must be doable at least in some cases.
> E.g. we have restrictions that requires directive on which some decision
> could be dependent must appear only lexically before it or not at all, etc.
> So, similarly to that, metadirective ideally should see if something is
> impossible already during parsing (dunno if it should mean we wouldn't parse
> the body in that case, that would mean worse diagnostics), then repeat the
> checks during gimplification like declare variant is resolved there, then
> repeat again after IPA.  Would be probably best if for metadirectives that
> resolve to executable directives we represent it by something like a magic
> IFN that is told everything needed to decide and can share as much code as
> possible with the declare variant decisions.
> 
> It is true other compilers implement offloading quite differently from GCC,
> by repeating all of preprocessing, parsing etc. for the offloading target,
> so they can decide some metadirective/declare variant decisions earlier than
> we can.  On the other side that approach has also quite some disadvantages,
> it is much harder to ensure ABI compatibility between the host and offload
> code if one can use #ifdefs and whatever to change layout of everything in
> between.
> 
> For the checks during parsing, we'll need a different way how to track which
> directives are currently active (or defer anything with construct
> selectors till gimplification).  It is true that resolving that during
> parsing goes against the goal to parse as many bodies together as possible,
> so we need to pick one or the other.  Parsing what follows for all
> standalone directives isn't a problem of course, but if the metadirective
> has one when with for and another with simd, then parsing the loop just once
> would be a problem if there is metadirective in the body that wants to
> decide whether it is in for or simd and wants that decision be done during
> parsing.
> 

In my current patch, I attempt to resolve metadirectives at three points 
- during parsing, during Gimplification, and just after LTO.

For Fortran only, I skipped the parser resolution for now - I originally 
wanted to reuse the code from the C/C++ front ends to resolve 
metadirectives when translating from the Fortran parse tree to tree 
form, but there are quite a few references to C-family only functions in 
it (it would need to be rewritten to be more frontend-neutral).

Thanks,

Kwok

[PATCH 0/7] openmp: OpenMP metadirectives support

[Kwok Cheung Yeung]

Hello

This is my current patchset for OpenMP metadirectives support. It aims 
to implement the specification from OpenMP 5.1, with dynamic selector 
support (though currently only the dynamic user selector set is 
supported), and supports the C, C++ and Fortran front ends.

The patch has been bootstrapped on a x86_64 Linux machine, and the 
testsuite run with no regressions (libgomp tested with both no 
offloading and with offloading to nvptx). Okay for inclusion in trunk?

Kwok

[PATCH 1/7] openmp: Add C support for parsing metadirectives

[Kwok Cheung Yeung]

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

This patch adds support for parsing metadirectives in the C parser.

Metadirectives are represented by a OMP_METADIRECTIVE tree node. It has 
a single operand (accessed by OMP_METADIRECTIVE_CLAUSES) which contains 
a chain of TREE_LIST nodes, each one representing a clause from the 
metadirective. TREE_PURPOSE(clause) contains the selector of the clause, 
while TREE_VALUE(clause) contains another TREE_LIST - the TREE_PURPOSE 
contains the tree for the directive, while the TREE_VALUE contains the 
standalone body (if any).

If an OMP directive has an associated body, it will be part of the tree 
at TREE_PURPOSE(TREE_VALUE(clause)) - the standalone body at 
TREE_VALUE(TREE_VALUE(clause) is only used for standalone directives 
that do not have an associated body (strictly speaking, it isn't a part 
of the directive variant at all). At present, all standalone bodies in a 
metadirective are shared, and will point to the same tree node.

Labels in the statement body are handled by first scanning the body for 
labels, then enclosing the statements in a lexical block with the found 
labels declared as local using __label__. This prevents labels in the 
body interfering with each other when the body is re-parsed.

I have removed support for the 'omp begin metadirective'..'omp end 
metadirective' form of the directive that was originally in the WIP 
patch. According to the spec, the only variant directives that can be 
used in this form must have an 'end <directive>' form (apart from the 
'nothing' directive), and in C/C++, the only directive that we support 
with an end form is 'declare target', which we currently forbid since it 
is declarative.

Kwok

[-- Attachment #2: 0001-openmp-Add-C-support-for-parsing-metadirectives.patch --]
[-- Type: text/plain, Size: 25231 bytes --]

From dc88559b0295104472a0cbf79de03b0549bd35f5 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 19:15:23 +0000
Subject: [PATCH 1/7] openmp: Add C support for parsing metadirectives

This patch implements parsing for the OpenMP metadirective introduced in
OpenMP 5.0.  Metadirectives are parsed into an OMP_METADIRECTIVE node,
with the variant clauses forming a chain accessible via
OMP_METADIRECTIVE_CLAUSES.  Each clause contains the context selector
and tree for the variant.

User conditions in the selector are now permitted to be non-constant when
used in metadirectives as specified in OpenMP 5.1.

2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* omp-general.c (omp_context_selector_matches): Add extra argument.
	(omp_resolve_metadirective): New stub function.
	* omp-general.h (struct omp_metadirective_variant): New.
	(omp_context_selector_matches): Add extra argument.
	(omp_resolve_metadirective): New prototype.
	* tree.def (OMP_METADIRECTIVE): New.
	* tree.h (OMP_METADIRECTIVE_CLAUSES): New macro.

	gcc/c/
	* c-parser.c (c_parser_skip_to_end_of_block_or_statement): Handle
	parentheses in statement.
	(c_parser_omp_metadirective): New prototype.
	(c_parser_omp_context_selector): Add extra argument.  Allow
	non-constant expressions.
	(c_parser_omp_context_selector_specification): Add extra argument and
	propagate it to c_parser_omp_context_selector.
	(analyze_metadirective_body): New.
	(c_parser_omp_metadirective): New.
	(c_parser_omp_construct): Handle PRAGMA_OMP_METADIRECTIVE.

	gcc/c-family
	* c-common.h (enum c_omp_directive_kind): Add C_OMP_DIR_META.
	(c_omp_expand_metadirective): New prototype.
	* c-gimplify.c (genericize_omp_metadirective_stmt): New.
	(c_genericize_control_stmt): Handle OMP_METADIRECTIVE tree nodes.
	* c-omp.c (omp_directives): Classify metadirectives as C_OMP_DIR_META.
	(c_omp_expand_metadirective): New stub function.
	* c-pragma.c (omp_pragmas): Add entry for metadirective.
	* c-pragma.h (enum pragma_kind): Add PRAGMA_OMP_METADIRECTIVE.
---
 gcc/c-family/c-common.h   |   4 +-
 gcc/c-family/c-gimplify.c |  25 +++
 gcc/c-family/c-omp.c      |  14 +-
 gcc/c-family/c-pragma.c   |   1 +
 gcc/c-family/c-pragma.h   |   1 +
 gcc/c/c-parser.c          | 403 +++++++++++++++++++++++++++++++++++++-
 gcc/omp-general.c         |  14 +-
 gcc/omp-general.h         |   9 +-
 gcc/tree.def              |   5 +
 gcc/tree.h                |   3 +
 10 files changed, 465 insertions(+), 14 deletions(-)

diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h
index c089fda12e4..ef37051791f 100644
--- a/gcc/c-family/c-common.h
+++ b/gcc/c-family/c-common.h
@@ -1257,7 +1257,8 @@ enum c_omp_directive_kind {
   C_OMP_DIR_CONSTRUCT,
   C_OMP_DIR_DECLARATIVE,
   C_OMP_DIR_UTILITY,
-  C_OMP_DIR_INFORMATIONAL
+  C_OMP_DIR_INFORMATIONAL,
+  C_OMP_DIR_META
 };
 
 struct c_omp_directive {
@@ -1270,6 +1271,7 @@ struct c_omp_directive {
 extern const struct c_omp_directive *c_omp_categorize_directive (const char *,
 								 const char *,
 								 const char *);
+extern tree c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &);
 
 /* Return next tree in the chain for chain_next walking of tree nodes.  */
 static inline tree
diff --git a/gcc/c-family/c-gimplify.c b/gcc/c-family/c-gimplify.c
index 0d38b706f4c..4c5feddf041 100644
--- a/gcc/c-family/c-gimplify.c
+++ b/gcc/c-family/c-gimplify.c
@@ -449,6 +449,26 @@ genericize_omp_for_stmt (tree *stmt_p, int *walk_subtrees, void *data,
   finish_bc_block (&OMP_FOR_BODY (stmt), bc_continue, clab);
 }
 
+/* Genericize a OMP_METADIRECTIVE node *STMT_P.  */
+
+static void
+genericize_omp_metadirective_stmt (tree *stmt_p, int *walk_subtrees,
+				   void *data, walk_tree_fn func,
+				   walk_tree_lh lh)
+{
+  tree stmt = *stmt_p;
+
+  for (tree clause = OMP_METADIRECTIVE_CLAUSES (stmt);
+       clause != NULL_TREE;
+       clause = TREE_CHAIN (clause))
+    {
+      tree variant = TREE_VALUE (clause);
+      walk_tree_1 (&TREE_PURPOSE (variant), func, data, NULL, lh);
+      walk_tree_1 (&TREE_VALUE (variant), func, data, NULL, lh);
+    }
+
+  *walk_subtrees = 0;
+}
 
 /* Lower structured control flow tree nodes, such as loops.  The
    STMT_P, WALK_SUBTREES, and DATA arguments are as for the walk_tree_fn
@@ -497,6 +517,11 @@ c_genericize_control_stmt (tree *stmt_p, int *walk_subtrees, void *data,
       genericize_omp_for_stmt (stmt_p, walk_subtrees, data, func, lh);
       break;
 
+    case OMP_METADIRECTIVE:
+      genericize_omp_metadirective_stmt (stmt_p, walk_subtrees, data, func,
+					 lh);
+      break;
+
     case STATEMENT_LIST:
       if (TREE_SIDE_EFFECTS (stmt))
 	{
diff --git a/gcc/c-family/c-omp.c b/gcc/c-family/c-omp.c
index 3f84fd1b5cb..9a7a6834f1b 100644
--- a/gcc/c-family/c-omp.c
+++ b/gcc/c-family/c-omp.c
@@ -3133,7 +3133,7 @@ static const struct c_omp_directive omp_directives[] = {
   /* { "begin", "declare", "variant", PRAGMA_OMP_BEGIN,
     C_OMP_DIR_DECLARATIVE, false }, */
   /* { "begin", "metadirective", nullptr, PRAGMA_OMP_BEGIN,
-    C_OMP_DIR_???, ??? },  */
+    C_OMP_DIR_META, false },  */
   { "cancel", nullptr, nullptr, PRAGMA_OMP_CANCEL,
     C_OMP_DIR_STANDALONE, false },
   { "cancellation", "point", nullptr, PRAGMA_OMP_CANCELLATION_POINT,
@@ -3163,7 +3163,7 @@ static const struct c_omp_directive omp_directives[] = {
   /* { "end", "declare", "variant", PRAGMA_OMP_END,
     C_OMP_DIR_DECLARATIVE, false }, */
   /* { "end", "metadirective", nullptr, PRAGMA_OMP_END,
-    C_OMP_DIR_???, ??? },  */
+    C_OMP_DIR_META, false },  */
   /* error with at(execution) is C_OMP_DIR_STANDALONE.  */
   { "error", nullptr, nullptr, PRAGMA_OMP_ERROR,
     C_OMP_DIR_UTILITY, false },
@@ -3179,8 +3179,8 @@ static const struct c_omp_directive omp_directives[] = {
     C_OMP_DIR_CONSTRUCT, true },
   { "master", nullptr, nullptr, PRAGMA_OMP_MASTER,
     C_OMP_DIR_CONSTRUCT, true },
-  /* { "metadirective", nullptr, nullptr, PRAGMA_OMP_METADIRECTIVE,
-    C_OMP_DIR_???, ??? },  */
+  { "metadirective", nullptr, nullptr, PRAGMA_OMP_METADIRECTIVE,
+    C_OMP_DIR_META, false },
   { "nothing", nullptr, nullptr, PRAGMA_OMP_NOTHING,
     C_OMP_DIR_UTILITY, false },
   /* ordered with depend clause is C_OMP_DIR_STANDALONE.  */
@@ -3263,3 +3263,9 @@ c_omp_categorize_directive (const char *first, const char *second,
     }
   return NULL;
 }
+
+tree
+c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &)
+{
+  return NULL_TREE;
+}
diff --git a/gcc/c-family/c-pragma.c b/gcc/c-family/c-pragma.c
index c4ed4205820..bd27de7f126 100644
--- a/gcc/c-family/c-pragma.c
+++ b/gcc/c-family/c-pragma.c
@@ -1365,6 +1365,7 @@ static const struct omp_pragma_def omp_pragmas[] = {
   { "error", PRAGMA_OMP_ERROR },
   { "end", PRAGMA_OMP_END_DECLARE_TARGET },
   { "flush", PRAGMA_OMP_FLUSH },
+  { "metadirective", PRAGMA_OMP_METADIRECTIVE },
   { "nothing", PRAGMA_OMP_NOTHING },
   { "requires", PRAGMA_OMP_REQUIRES },
   { "scope", PRAGMA_OMP_SCOPE },
diff --git a/gcc/c-family/c-pragma.h b/gcc/c-family/c-pragma.h
index 0c5b07ab4e1..145260e0c20 100644
--- a/gcc/c-family/c-pragma.h
+++ b/gcc/c-family/c-pragma.h
@@ -61,6 +61,7 @@ enum pragma_kind {
   PRAGMA_OMP_NOTHING,
   PRAGMA_OMP_MASKED,
   PRAGMA_OMP_MASTER,
+  PRAGMA_OMP_METADIRECTIVE,
   PRAGMA_OMP_ORDERED,
   PRAGMA_OMP_PARALLEL,
   PRAGMA_OMP_REQUIRES,
diff --git a/gcc/c/c-parser.c b/gcc/c/c-parser.c
index e99c84776f1..9689a221975 100644
--- a/gcc/c/c-parser.c
+++ b/gcc/c/c-parser.c
@@ -1390,6 +1390,17 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
 	  ++nesting_depth;
 	  break;
 
+	case CPP_OPEN_PAREN:
+	  /* Track parentheses in case the statement is a standalone 'for'
+	     statement - we want to skip over the semicolons separating the
+	     operands.  */
+	  nesting_depth++;
+	  break;
+
+	case CPP_CLOSE_PAREN:
+	  nesting_depth--;
+	  break;
+
 	case CPP_PRAGMA:
 	  /* If we see a pragma, consume the whole thing at once.  We
 	     have some safeguards against consuming pragmas willy-nilly.
@@ -1586,6 +1597,8 @@ static bool c_parser_omp_cancellation_point (c_parser *, enum pragma_context);
 static bool c_parser_omp_target (c_parser *, enum pragma_context, bool *);
 static void c_parser_omp_end_declare_target (c_parser *);
 static bool c_parser_omp_declare (c_parser *, enum pragma_context);
+static tree c_parser_omp_metadirective (location_t, c_parser *, char *,
+					omp_clause_mask, tree *, bool *);
 static void c_parser_omp_requires (c_parser *);
 static bool c_parser_omp_error (c_parser *, enum pragma_context);
 static bool c_parser_omp_ordered (c_parser *, enum pragma_context, bool *);
@@ -19187,6 +19200,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
   location_t for_loc;
   bool tiling = false;
   bool inscan = false;
+
   vec<tree, va_gc> *for_block = make_tree_vector ();
 
   for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))
@@ -21398,7 +21412,8 @@ static const char *const omp_user_selectors[] = {
      score(score-expression)  */
 
 static tree
-c_parser_omp_context_selector (c_parser *parser, tree set, tree parms)
+c_parser_omp_context_selector (c_parser *parser, tree set, tree parms,
+			       bool metadirective_p)
 {
   tree ret = NULL_TREE;
   do
@@ -21606,10 +21621,16 @@ c_parser_omp_context_selector (c_parser *parser, tree set, tree parms)
 		{
 		  mark_exp_read (t);
 		  t = c_fully_fold (t, false, NULL);
-		  if (!INTEGRAL_TYPE_P (TREE_TYPE (t))
-		      || !tree_fits_shwi_p (t))
+		  if (!metadirective_p
+		      && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
+			  || !tree_fits_shwi_p (t)))
 		    error_at (token->location, "property must be "
-			      "constant integer expression");
+					       "constant integer expression");
+		  else if (metadirective_p
+			   && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
+		    /* Allow non-constant user expressions in metadirectives.  */
+		    error_at (token->location, "property must be "
+					       "integer expression");
 		  else
 		    properties = tree_cons (NULL_TREE, t, properties);
 		}
@@ -21675,7 +21696,8 @@ c_parser_omp_context_selector (c_parser *parser, tree set, tree parms)
      user  */
 
 static tree
-c_parser_omp_context_selector_specification (c_parser *parser, tree parms)
+c_parser_omp_context_selector_specification (c_parser *parser, tree parms,
+					     bool metadirective_p = false)
 {
   tree ret = NULL_TREE;
   do
@@ -21721,7 +21743,8 @@ c_parser_omp_context_selector_specification (c_parser *parser, tree parms)
       if (!braces.require_open (parser))
 	return error_mark_node;
 
-      tree selectors = c_parser_omp_context_selector (parser, set, parms);
+      tree selectors = c_parser_omp_context_selector (parser, set, parms,
+						      metadirective_p);
       if (selectors == error_mark_node)
 	ret = error_mark_node;
       else if (ret != error_mark_node)
@@ -22930,6 +22953,368 @@ c_parser_omp_error (c_parser *parser, enum pragma_context context)
   return false;
 }
 
+/* Helper function for c_parser_omp_metadirective.  */
+
+static void
+analyze_metadirective_body (c_parser *parser,
+			    vec<c_token> &tokens,
+			    vec<tree> &labels)
+{
+  int nesting_depth = 0;
+  int bracket_depth = 0;
+  bool ignore_label = false;
+
+  /* Read in the body tokens to the tokens for each candidate directive.  */
+  while (1)
+    {
+      c_token *token = c_parser_peek_token (parser);
+      bool stop = false;
+
+      if (c_parser_next_token_is_keyword (parser, RID_CASE))
+	ignore_label = true;
+
+      switch (token->type)
+	{
+	case CPP_EOF:
+	  break;
+	case CPP_NAME:
+	  if (!ignore_label
+	      && c_parser_peek_2nd_token (parser)->type == CPP_COLON)
+	    labels.safe_push (token->value);
+	  goto add;
+	case CPP_OPEN_BRACE:
+	  ++nesting_depth;
+	  goto add;
+	case CPP_CLOSE_BRACE:
+	  if (--nesting_depth == 0)
+	    stop = true;
+	  goto add;
+	case CPP_OPEN_PAREN:
+	  ++bracket_depth;
+	  goto add;
+	case CPP_CLOSE_PAREN:
+	  --bracket_depth;
+	  goto add;
+	case CPP_COLON:
+	  ignore_label = false;
+	  goto add;
+	case CPP_SEMICOLON:
+	  if (nesting_depth == 0 && bracket_depth == 0)
+	    stop = true;
+	  goto add;
+	default:
+	add:
+	  tokens.safe_push (*token);
+	  if (token->type == CPP_PRAGMA)
+	    c_parser_consume_pragma (parser);
+	  else if (token->type == CPP_PRAGMA_EOL)
+	    c_parser_skip_to_pragma_eol (parser);
+	  else
+	    c_parser_consume_token (parser);
+	  if (stop)
+	    break;
+	  continue;
+	}
+      break;
+    }
+}
+
+/* OpenMP 5.0:
+
+  # pragma omp metadirective [clause[, clause]]
+*/
+
+static tree
+c_parser_omp_metadirective (location_t loc, c_parser *parser,
+			    char *p_name, omp_clause_mask, tree *,
+			    bool *if_p)
+{
+  tree ret;
+  auto_vec<c_token> directive_tokens;
+  auto_vec<c_token> body_tokens;
+  auto_vec<tree> body_labels;
+  auto_vec<const struct c_omp_directive *> directives;
+  auto_vec<tree> ctxs;
+  vec<struct omp_metadirective_variant> candidates;
+  bool default_seen = false;
+  int directive_token_idx = 0;
+  tree standalone_body = NULL_TREE;
+
+  ret = make_node (OMP_METADIRECTIVE);
+  SET_EXPR_LOCATION (ret, loc);
+  TREE_TYPE (ret) = void_type_node;
+  OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
+  strcat (p_name, " metadirective");
+
+  while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
+    {
+      if (c_parser_next_token_is_not (parser, CPP_NAME)
+	  && c_parser_next_token_is_not (parser, CPP_KEYWORD))
+	{
+	  c_parser_error (parser, "expected %<when%> or %<default%>");
+	  goto error;
+	}
+
+      location_t match_loc = c_parser_peek_token (parser)->location;
+      const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+      c_parser_consume_token (parser);
+      bool default_p = strcmp (p, "default") == 0;
+      if (default_p)
+	{
+	  if (default_seen)
+	    {
+	      c_parser_error (parser, "there can only be one default clause "
+				      "in a metadirective");
+	      goto error;
+	    }
+	  default_seen = true;
+	}
+      if (!(strcmp (p, "when") == 0 || default_p))
+	{
+	  c_parser_error (parser, "expected %<when%> or %<default%>");
+	  goto error;
+	}
+
+      matching_parens parens;
+      tree ctx = NULL_TREE;
+      bool skip = false;
+
+      if (!parens.require_open (parser))
+	goto error;
+
+      if (!default_p)
+	{
+	  ctx = c_parser_omp_context_selector_specification (parser,
+							     NULL_TREE, true);
+	  if (ctx == error_mark_node)
+	    goto error;
+	  ctx = omp_check_context_selector (match_loc, ctx);
+	  if (ctx == error_mark_node)
+	    goto error;
+
+	  /* Remove the selector from further consideration if can be
+	     evaluated as a non-match at this point.  */
+	  skip = (omp_context_selector_matches (ctx, true) == 0);
+
+	  if (c_parser_next_token_is_not (parser, CPP_COLON))
+	    {
+	      c_parser_error (parser, "expected colon");
+	      goto error;
+	    }
+	  c_parser_consume_token (parser);
+	}
+
+      /* Read in the directive type and create a dummy pragma token for
+	 it.  */
+      location_t loc = c_parser_peek_token (parser)->location;
+
+      p = NULL;
+      if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN))
+	p = "nothing";
+      else if (c_parser_next_token_is_keyword (parser, RID_FOR))
+	{
+	  p = "for";
+	  c_parser_consume_token (parser);
+	}
+      else if (c_parser_next_token_is (parser, CPP_NAME))
+	{
+	  p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
+	  c_parser_consume_token (parser);
+	}
+
+      if (p == NULL)
+	{
+	  c_parser_error (parser, "expected directive name");
+	  goto error;
+	}
+
+      const struct c_omp_directive *omp_directive
+	= c_omp_categorize_directive (p, NULL, NULL);
+
+      if (omp_directive == NULL)
+	{
+	  c_parser_error (parser, "unknown directive name");
+	  goto error;
+	}
+      if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
+	{
+	  c_parser_error (parser,
+			  "metadirectives cannot be used as directive "
+			  "variants");
+	  goto error;
+	}
+      if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
+	{
+	  sorry_at (loc, "declarative directive variants are not supported");
+	  goto error;
+	}
+
+      if (!skip)
+	{
+	  c_token pragma_token;
+	  pragma_token.type = CPP_PRAGMA;
+	  pragma_token.location = loc;
+	  pragma_token.pragma_kind = (enum pragma_kind) omp_directive->id;
+
+	  directives.safe_push (omp_directive);
+	  directive_tokens.safe_push (pragma_token);
+	  ctxs.safe_push (ctx);
+	}
+
+      /* Read in tokens for the directive clauses.  */
+      int nesting_depth = 0;
+      while (1)
+	{
+	  c_token *token = c_parser_peek_token (parser);
+	  switch (token->type)
+	    {
+	    case CPP_EOF:
+	    case CPP_PRAGMA_EOL:
+	      break;
+	    case CPP_OPEN_PAREN:
+	      ++nesting_depth;
+	      goto add;
+	    case CPP_CLOSE_PAREN:
+	      if (nesting_depth-- == 0)
+		break;
+	      goto add;
+	    default:
+	    add:
+	      if (!skip)
+		directive_tokens.safe_push (*token);
+	      c_parser_consume_token (parser);
+	      continue;
+	    }
+	  break;
+	}
+
+      c_parser_consume_token (parser);
+
+      if (!skip)
+	{
+	  c_token eol_token;
+	  memset (&eol_token, 0, sizeof (eol_token));
+	  eol_token.type = CPP_PRAGMA_EOL;
+	  directive_tokens.safe_push (eol_token);
+	}
+    }
+  c_parser_skip_to_pragma_eol (parser);
+
+  if (!default_seen)
+    {
+      /* Add a default clause that evaluates to 'omp nothing'.  */
+      const struct c_omp_directive *omp_directive
+	= c_omp_categorize_directive ("nothing", NULL, NULL);
+
+      c_token pragma_token;
+      pragma_token.type = CPP_PRAGMA;
+      pragma_token.location = UNKNOWN_LOCATION;
+      pragma_token.pragma_kind = PRAGMA_OMP_NOTHING;
+
+      directives.safe_push (omp_directive);
+      directive_tokens.safe_push (pragma_token);
+      ctxs.safe_push (NULL_TREE);
+
+      c_token eol_token;
+      memset (&eol_token, 0, sizeof (eol_token));
+      eol_token.type = CPP_PRAGMA_EOL;
+      directive_tokens.safe_push (eol_token);
+    }
+
+  analyze_metadirective_body (parser, body_tokens, body_labels);
+
+  /* Process each candidate directive.  */
+  unsigned i;
+  tree ctx;
+
+  FOR_EACH_VEC_ELT (ctxs, i, ctx)
+    {
+      auto_vec<c_token> tokens;
+
+      /* Add the directive tokens.  */
+      do
+	tokens.safe_push (directive_tokens [directive_token_idx++]);
+      while (tokens.last ().type != CPP_PRAGMA_EOL);
+
+      /* Add the body tokens.  */
+      for (unsigned j = 0; j < body_tokens.length (); j++)
+	tokens.safe_push (body_tokens[j]);
+
+      /* Make sure nothing tries to read past the end of the tokens.  */
+      c_token eof_token;
+      memset (&eof_token, 0, sizeof (eof_token));
+      eof_token.type = CPP_EOF;
+      tokens.safe_push (eof_token);
+      tokens.safe_push (eof_token);
+
+      unsigned int old_tokens_avail = parser->tokens_avail;
+      c_token *old_tokens = parser->tokens;
+
+      parser->tokens = tokens.address ();
+      parser->tokens_avail = tokens.length ();
+
+      tree directive = c_begin_compound_stmt (true);
+
+      /* Declare all non-local labels that occur within the directive body
+	 as local.  */
+      for (unsigned j = 0; j < body_labels.length (); j++)
+	{
+	  tree label = declare_label (body_labels[j]);
+
+	  C_DECLARED_LABEL_FLAG (label) = 1;
+	  add_stmt (build_stmt (loc, DECL_EXPR, label));
+	}
+
+      c_parser_pragma (parser, pragma_compound, if_p);
+      directive = c_end_compound_stmt (loc, directive, true);
+      bool standalone_p
+	= directives[i]->kind == C_OMP_DIR_STANDALONE
+	  || directives[i]->kind == C_OMP_DIR_UTILITY;
+      if (standalone_p)
+	{
+	  /* Parsing standalone directives will not consume the body
+	     tokens, so do that here.  */
+	  if (standalone_body == NULL_TREE)
+	    {
+	      standalone_body = push_stmt_list ();
+	      c_parser_statement (parser, if_p);
+	      standalone_body = pop_stmt_list (standalone_body);
+	    }
+	  else
+	    c_parser_skip_to_end_of_block_or_statement (parser);
+	}
+
+      tree body = standalone_p ? standalone_body : NULL_TREE;
+      tree variant = build_tree_list (ctx, build_tree_list (directive, body));
+      OMP_METADIRECTIVE_CLAUSES (ret)
+	= chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
+
+      /* Check that all valid tokens have been consumed.  */
+      gcc_assert (parser->tokens_avail == 2);
+      gcc_assert (c_parser_next_token_is (parser, CPP_EOF));
+      gcc_assert (c_parser_peek_2nd_token (parser)->type == CPP_EOF);
+
+      parser->tokens = old_tokens;
+      parser->tokens_avail = old_tokens_avail;
+    }
+
+  /* Try to resolve the metadirective early.  */
+  candidates = omp_resolve_metadirective (ret);
+  if (!candidates.is_empty ())
+    ret = c_omp_expand_metadirective (candidates);
+
+  add_stmt (ret);
+
+  return ret;
+
+error:
+  if (parser->in_pragma)
+    c_parser_skip_to_pragma_eol (parser);
+  c_parser_skip_to_end_of_block_or_statement (parser);
+
+  return NULL_TREE;
+}
+
 /* Main entry point to parsing most OpenMP pragmas.  */
 
 static void
@@ -23003,6 +23388,11 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
       strcpy (p_name, "#pragma omp");
       stmt = c_parser_omp_master (loc, parser, p_name, mask, NULL, if_p);
       break;
+    case PRAGMA_OMP_METADIRECTIVE:
+      strcpy (p_name, "#pragma omp");
+      stmt = c_parser_omp_metadirective (loc, parser, p_name, mask, NULL,
+					 if_p);
+      break;
     case PRAGMA_OMP_PARALLEL:
       strcpy (p_name, "#pragma omp");
       stmt = c_parser_omp_parallel (loc, parser, p_name, mask, NULL, if_p);
@@ -23043,7 +23433,6 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
     gcc_assert (EXPR_LOCATION (stmt) != UNKNOWN_LOCATION);
 }
 
-
 /* OpenMP 2.5:
    # pragma omp threadprivate (variable-list) */
 
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 8fcca730471..9926cfd9d5f 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -1260,7 +1260,7 @@ omp_context_name_list_prop (tree prop)
    IPA, others until vectorization.  */
 
 int
-omp_context_selector_matches (tree ctx)
+omp_context_selector_matches (tree ctx, bool)
 {
   int ret = 1;
   for (tree t1 = ctx; t1; t1 = TREE_CHAIN (t1))
@@ -2624,6 +2624,18 @@ omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
 						 INSERT) = entryp;
 }
 
+/* Return a vector of dynamic replacement candidates for the metadirective
+   statement in METADIRECTIVE.  Return an empty vector if the metadirective
+   cannot be resolved.  */
+
+vec<struct omp_metadirective_variant>
+omp_resolve_metadirective (tree)
+{
+  vec<struct omp_metadirective_variant> variants = {};
+
+  return variants;
+}
+
 /* Encode an oacc launch argument.  This matches the GOMP_LAUNCH_PACK
    macro on gomp-constants.h.  We do not check for overflow.  */
 
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index a0c7c71148c..8c6009e9854 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -89,6 +89,12 @@ struct omp_for_data
   tree adjn1;
 };
 
+/* A structure describing a variant in a metadirective.  */
+
+struct omp_metadirective_variant
+{
+};
+
 #define OACC_FN_ATTRIB "oacc function"
 
 extern tree omp_find_clause (tree clauses, enum omp_clause_code kind);
@@ -108,10 +114,11 @@ extern int omp_constructor_traits_to_codes (tree, enum tree_code *);
 extern tree omp_check_context_selector (location_t loc, tree ctx);
 extern void omp_mark_declare_variant (location_t loc, tree variant,
 				      tree construct);
-extern int omp_context_selector_matches (tree);
+extern int omp_context_selector_matches (tree, bool = false);
 extern int omp_context_selector_set_compare (const char *, tree, tree);
 extern tree omp_get_context_selector (tree, const char *, const char *);
 extern tree omp_resolve_declare_variant (tree);
+extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (tree);
 extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
 extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
 extern void oacc_replace_fn_attrib (tree fn, tree dims);
diff --git a/gcc/tree.def b/gcc/tree.def
index e27bc3e2b1f..91f8c4db1e3 100644
--- a/gcc/tree.def
+++ b/gcc/tree.def
@@ -1274,6 +1274,11 @@ DEFTREECODE (OMP_TARGET_ENTER_DATA, "omp_target_enter_data", tcc_statement, 1)
    Operand 0: OMP_TARGET_EXIT_DATA_CLAUSES: List of clauses.  */
 DEFTREECODE (OMP_TARGET_EXIT_DATA, "omp_target_exit_data", tcc_statement, 1)
 
+/* OpenMP - #pragma omp metadirective [clause1 ... clauseN]
+   Operand 0: OMP_METADIRECTIVE_CLAUSES: List of selectors and directive
+	variants.  */
+DEFTREECODE (OMP_METADIRECTIVE, "omp_metadirective", tcc_statement, 1)
+
 /* OMP_ATOMIC through OMP_ATOMIC_CAPTURE_NEW must be consecutive,
    or OMP_ATOMIC_SEQ_CST needs adjusting.  */
 
diff --git a/gcc/tree.h b/gcc/tree.h
index 094501bd9b1..06c8140e011 100644
--- a/gcc/tree.h
+++ b/gcc/tree.h
@@ -1471,6 +1471,9 @@ class auto_suppress_location_wrappers
 #define OMP_TARGET_EXIT_DATA_CLAUSES(NODE)\
   TREE_OPERAND (OMP_TARGET_EXIT_DATA_CHECK (NODE), 0)
 
+#define OMP_METADIRECTIVE_CLAUSES(NODE) \
+  TREE_OPERAND (OMP_METADIRECTIVE_CHECK (NODE), 0)
+
 #define OMP_SCAN_BODY(NODE)	TREE_OPERAND (OMP_SCAN_CHECK (NODE), 0)
 #define OMP_SCAN_CLAUSES(NODE)	TREE_OPERAND (OMP_SCAN_CHECK (NODE), 1)
 
-- 
2.25.1

[PATCH] openmp: Improve handling of nested OpenMP metadirectives in C and C++ (was: Re: [PATCH 1/7] openmp: Add C support for parsing metadirectives)

[Kwok Cheung Yeung]

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

This patch (to be applied on top of the metadirective patch series) 
addresses issues found in the C/C++ parsers when nested metadirectives 
are used.

analyze_metadirective_body when encountering code like:

#pragma omp metadirective when {set={...}: A)
   #pragma omp metadirective when (set={...}: B)

would stop just before ': B' before it naively assumes that the '}' 
marks the end of the body associated with the first metadirective, when 
it needs to include the whole of the second metadirective plus its 
associated body. This is fixed by checking that the nesting level of 
parentheses is zero as well before stopping the gathering of tokens.

The assert on the remaining tokens after parsing a clause can fail 
(resulting in an ICE) if there is a parse error in the directive or the 
body, since in that case not all tokens may be processed before parsing 
aborts early. The assert is therefore not enforced if any parse errors 
occur in the clause.

I have also moved the handling of the metadirective pragma from 
c_parser_omp_construct to c_parser_pragma (and their C++ equivalents), 
since c_parser_omp_construct has some checks that do not apply to 
metadirectives.

Kwok

[-- Attachment #2: 0001-openmp-Improve-handling-of-nested-OpenMP-metadirecti.patch --]
[-- Type: text/plain, Size: 13354 bytes --]

From a9e4936b8476b97f11bb81b416ef3d28fa60cd37 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 18 Feb 2022 19:00:57 +0000
Subject: [PATCH] openmp: Improve handling of nested OpenMP metadirectives in C
 and C++

This patch fixes a misparsing issue when encountering code like:

  #pragma omp metadirective when {<selector_set>={...}: A)
    #pragma omp metadirective when (<selector_set>={...}: B)

When called for the first metadirective, analyze_metadirective_body would
stop just before the colon in the second metadirective because it naively
assumes that the '}' marks the end of a code block.

The assertion for clauses to end parsing at the same point is now disabled
if a parse error has occurred during the parsing of the clause, since some
tokens may not be consumed if a parse error cuts parsing short.

2022-02-18  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/c/
	* c-parser.cc (c_parser_omp_construct): Move handling of
	PRAGMA_OMP_METADIRECTIVE from here...
	(c_parser_pragma): ...to here.
	(analyze_metadirective_body): Check that the bracket nesting level
	is also zero before stopping the adding of tokens on encountering a
	close brace.
	(c_parser_omp_metadirective): Modify function signature and update.
	Do not assert on remaining tokens if there has been a parse error.

	gcc/cp/
	* parser.cc (cp_parser_omp_construct): Move handling of
	PRAGMA_OMP_METADIRECTIVE from here...
	(cp_parser_pragma): ...to here.
	(analyze_metadirective_body): Check that the bracket
	nesting level is also zero before stopping the adding of tokens on
	encountering a close brace.
	(cp_parser_omp_metadirective): Modify function signature and update.
	Do not assert on remaining tokens if there has been a parse error.

	gcc/testsuite/
	* c-c++-common/gomp/metadirective-1.c (f): Add test for
	improperly nested metadirectives.
---
 gcc/c/c-parser.cc                             | 47 +++++++++----------
 gcc/cp/parser.cc                              | 33 ++++++-------
 .../c-c++-common/gomp/metadirective-1.c       | 13 +++++
 3 files changed, 51 insertions(+), 42 deletions(-)

diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 58fcbb398ee..6a134e0fb50 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -1592,6 +1592,7 @@ static void c_parser_omp_taskwait (c_parser *);
 static void c_parser_omp_taskyield (c_parser *);
 static void c_parser_omp_cancel (c_parser *);
 static void c_parser_omp_nothing (c_parser *);
+static void c_parser_omp_metadirective (c_parser *, bool *);
 
 enum pragma_context { pragma_external, pragma_struct, pragma_param,
 		      pragma_stmt, pragma_compound };
@@ -1600,8 +1601,6 @@ static bool c_parser_omp_cancellation_point (c_parser *, enum pragma_context);
 static bool c_parser_omp_target (c_parser *, enum pragma_context, bool *);
 static void c_parser_omp_end_declare_target (c_parser *);
 static bool c_parser_omp_declare (c_parser *, enum pragma_context);
-static tree c_parser_omp_metadirective (location_t, c_parser *, char *,
-					omp_clause_mask, tree *, bool *);
 static void c_parser_omp_requires (c_parser *);
 static bool c_parser_omp_error (c_parser *, enum pragma_context);
 static bool c_parser_omp_ordered (c_parser *, enum pragma_context, bool *);
@@ -12551,6 +12550,10 @@ c_parser_pragma (c_parser *parser, enum pragma_context context, bool *if_p)
       c_parser_omp_nothing (parser);
       return false;
 
+    case PRAGMA_OMP_METADIRECTIVE:
+      c_parser_omp_metadirective (parser, if_p);
+      return true;
+
     case PRAGMA_OMP_ERROR:
       return c_parser_omp_error (parser, context);
 
@@ -23020,7 +23023,7 @@ analyze_metadirective_body (c_parser *parser,
 	  ++nesting_depth;
 	  goto add;
 	case CPP_CLOSE_BRACE:
-	  if (--nesting_depth == 0)
+	  if (--nesting_depth == 0 && bracket_depth == 0)
 	    stop = true;
 	  goto add;
 	case CPP_OPEN_PAREN:
@@ -23058,10 +23061,8 @@ analyze_metadirective_body (c_parser *parser,
   # pragma omp metadirective [clause[, clause]]
 */
 
-static tree
-c_parser_omp_metadirective (location_t loc, c_parser *parser,
-			    char *p_name, omp_clause_mask, tree *,
-			    bool *if_p)
+static void
+c_parser_omp_metadirective (c_parser *parser, bool *if_p)
 {
   tree ret;
   auto_vec<c_token> directive_tokens;
@@ -23073,13 +23074,14 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
   bool default_seen = false;
   int directive_token_idx = 0;
   tree standalone_body = NULL_TREE;
+  location_t pragma_loc = c_parser_peek_token (parser)->location;
 
   ret = make_node (OMP_METADIRECTIVE);
-  SET_EXPR_LOCATION (ret, loc);
+  SET_EXPR_LOCATION (ret, pragma_loc);
   TREE_TYPE (ret) = void_type_node;
   OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
-  strcat (p_name, " metadirective");
 
+  c_parser_consume_pragma (parser);
   while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
     {
       if (c_parser_next_token_is_not (parser, CPP_NAME)
@@ -23287,6 +23289,7 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
       parser->tokens = tokens.address ();
       parser->tokens_avail = tokens.length ();
 
+      int prev_errorcount = errorcount;
       tree directive = c_begin_compound_stmt (true);
 
       /* Declare all non-local labels that occur within the directive body
@@ -23296,11 +23299,11 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
 	  tree label = declare_label (body_labels[j]);
 
 	  C_DECLARED_LABEL_FLAG (label) = 1;
-	  add_stmt (build_stmt (loc, DECL_EXPR, label));
+	  add_stmt (build_stmt (pragma_loc, DECL_EXPR, label));
 	}
 
       c_parser_pragma (parser, pragma_compound, if_p);
-      directive = c_end_compound_stmt (loc, directive, true);
+      directive = c_end_compound_stmt (pragma_loc, directive, true);
       bool standalone_p
 	= directives[i]->kind == C_OMP_DIR_STANDALONE
 	  || directives[i]->kind == C_OMP_DIR_UTILITY;
@@ -23323,10 +23326,14 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
       OMP_METADIRECTIVE_CLAUSES (ret)
 	= chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
 
-      /* Check that all valid tokens have been consumed.  */
-      gcc_assert (parser->tokens_avail == 2);
-      gcc_assert (c_parser_next_token_is (parser, CPP_EOF));
-      gcc_assert (c_parser_peek_2nd_token (parser)->type == CPP_EOF);
+      /* Check that all valid tokens have been consumed if no parse errors
+	 encountered.  */
+      if (errorcount == prev_errorcount)
+	{
+	  gcc_assert (parser->tokens_avail == 2);
+	  gcc_assert (c_parser_next_token_is (parser, CPP_EOF));
+	  gcc_assert (c_parser_peek_2nd_token (parser)->type == CPP_EOF);
+	}
 
       parser->tokens = old_tokens;
       parser->tokens_avail = old_tokens_avail;
@@ -23338,15 +23345,12 @@ c_parser_omp_metadirective (location_t loc, c_parser *parser,
     ret = c_omp_expand_metadirective (candidates);
 
   add_stmt (ret);
-
-  return ret;
+  return;
 
 error:
   if (parser->in_pragma)
     c_parser_skip_to_pragma_eol (parser);
   c_parser_skip_to_end_of_block_or_statement (parser);
-
-  return NULL_TREE;
 }
 
 /* Main entry point to parsing most OpenMP pragmas.  */
@@ -23422,11 +23426,6 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
       strcpy (p_name, "#pragma omp");
       stmt = c_parser_omp_master (loc, parser, p_name, mask, NULL, if_p);
       break;
-    case PRAGMA_OMP_METADIRECTIVE:
-      strcpy (p_name, "#pragma omp");
-      stmt = c_parser_omp_metadirective (loc, parser, p_name, mask, NULL,
-					 if_p);
-      break;
     case PRAGMA_OMP_PARALLEL:
       strcpy (p_name, "#pragma omp");
       stmt = c_parser_omp_parallel (loc, parser, p_name, mask, NULL, if_p);
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index aa23688814a..ef33cb1611f 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -45985,7 +45985,7 @@ cp_parser_omp_end_declare_target (cp_parser *parser, cp_token *pragma_tok)
 }
 
 
-/* Helper function for c_parser_omp_metadirective.  */
+/* Helper function for cp_parser_omp_metadirective.  */
 
 static void
 analyze_metadirective_body (cp_parser *parser,
@@ -46021,7 +46021,7 @@ analyze_metadirective_body (cp_parser *parser,
 	  ++nesting_depth;
 	  goto add;
 	case CPP_CLOSE_BRACE:
-	  if (--nesting_depth == 0)
+	  if (--nesting_depth == 0 && bracket_depth == 0)
 	    stop = true;
 	  goto add;
 	case CPP_OPEN_PAREN:
@@ -46056,9 +46056,8 @@ analyze_metadirective_body (cp_parser *parser,
   # pragma omp metadirective [clause[, clause]]
 */
 
-static tree
+static void
 cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
-			     char *p_name, omp_clause_mask, tree *,
 			     bool *if_p)
 {
   tree ret;
@@ -46069,15 +46068,14 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
   auto_vec<tree> ctxs;
   bool default_seen = false;
   int directive_token_idx = 0;
-  location_t loc = cp_lexer_peek_token (parser->lexer)->location;
+  location_t pragma_loc = pragma_tok->location;
   tree standalone_body = NULL_TREE;
   vec<struct omp_metadirective_variant> candidates;
 
   ret = make_node (OMP_METADIRECTIVE);
-  SET_EXPR_LOCATION (ret, loc);
+  SET_EXPR_LOCATION (ret, pragma_loc);
   TREE_TYPE (ret) = void_type_node;
   OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
-  strcat (p_name, " metadirective");
 
   while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
     {
@@ -46296,6 +46294,7 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
       parser->lexer = lexer;
       cp_lexer_set_source_position_from_token (lexer->next_token);
 
+      int prev_errorcount = errorcount;
       tree directive = push_stmt_list ();
       tree directive_stmt = begin_compound_stmt (0);
 
@@ -46330,8 +46329,10 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
       OMP_METADIRECTIVE_CLAUSES (ret)
 	= chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
 
-      /* Check that all valid tokens have been consumed.  */
-      gcc_assert (cp_lexer_next_token_is (parser->lexer, CPP_EOF));
+      /* Check that all valid tokens have been consumed if no parse errors
+	 encountered.  */
+      gcc_assert (errorcount != prev_errorcount
+		  || cp_lexer_next_token_is (parser->lexer, CPP_EOF));
 
       parser->lexer = old_lexer;
       cp_lexer_set_source_position_from_token (old_lexer->next_token);
@@ -46343,8 +46344,7 @@ cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
     ret = c_omp_expand_metadirective (candidates);
 
   add_stmt (ret);
-
-  return ret;
+  return;
 
 fail:
   /* Skip the metadirective pragma.  */
@@ -46352,7 +46352,6 @@ fail:
 
   /* Skip the metadirective body.  */
   cp_parser_skip_to_end_of_block_or_statement (parser);
-  return error_mark_node;
 }
 
 
@@ -47602,11 +47601,6 @@ cp_parser_omp_construct (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
       stmt = cp_parser_omp_master (parser, pragma_tok, p_name, mask, NULL,
 				   if_p);
       break;
-    case PRAGMA_OMP_METADIRECTIVE:
-      strcpy (p_name, "#pragma omp");
-      stmt = cp_parser_omp_metadirective (parser, pragma_tok, p_name, mask,
-					  NULL, if_p);
-      break;
     case PRAGMA_OMP_PARALLEL:
       strcpy (p_name, "#pragma omp");
       stmt = cp_parser_omp_parallel (parser, pragma_tok, p_name, mask, NULL,
@@ -48257,7 +48251,6 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
     case PRAGMA_OMP_LOOP:
     case PRAGMA_OMP_MASKED:
     case PRAGMA_OMP_MASTER:
-    case PRAGMA_OMP_METADIRECTIVE:
     case PRAGMA_OMP_PARALLEL:
     case PRAGMA_OMP_SCOPE:
     case PRAGMA_OMP_SECTIONS:
@@ -48289,6 +48282,10 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
       cp_parser_omp_nothing (parser, pragma_tok);
       return false;
 
+    case PRAGMA_OMP_METADIRECTIVE:
+      cp_parser_omp_metadirective (parser, pragma_tok, if_p);
+      return true;
+
     case PRAGMA_OMP_ERROR:
       return cp_parser_omp_error (parser, pragma_tok, context);
 
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
index 72cf0abbbd7..543063a3324 100644
--- a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
@@ -4,6 +4,8 @@
 
 void f (int a[], int b[], int c[])
 {
+  int i;
+
   #pragma omp metadirective \
       default (teams loop) \
       default (parallel loop) /* { dg-error "there can only be one default clause in a metadirective before '\\(' token" } */
@@ -26,4 +28,15 @@ void f (int a[], int b[], int c[])
   #pragma omp metadirective \
 	default (metadirective default (flush))	/* { dg-error "metadirectives cannot be used as directive variants before 'default'" } */
     for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+  /* Test improperly nested metadirectives - even though the second
+     metadirective resolves to 'omp nothing', that is not the same as there
+     being literally nothing there.  */
+  #pragma omp metadirective \
+      when (implementation={vendor("gnu")}: parallel for)
+    #pragma omp metadirective \
+	when (implementation={vendor("cray")}: parallel for)
+	/* { dg-error "for statement expected before '#pragma'" "" { target c } .-2 } */
+	/* { dg-error "'#pragma' is not allowed here" "" { target c++ } .-3 } */
+      for (i = 0; i < N; i++) c[i] = a[i] * b[i];
 }
-- 
2.25.1

[og11][committed] openmp: Improve handling of nested OpenMP metadirectives in C and C++

[Kwok Cheung Yeung]

This patch has been committed to the devel/omp/gcc-11 development branch:

249df772b70f7b9f50f68030d4ea9c25624cc578  openmp: Improve handling of 
nested OpenMP metadirectives in C and C++

Kwok

Re: [PATCH 1/7] openmp: Add C support for parsing metadirectives

[Jakub Jelinek]

On Fri, Dec 10, 2021 at 05:31:08PM +0000, Kwok Cheung Yeung wrote:
> This patch adds support for parsing metadirectives in the C parser.
> 
> Metadirectives are represented by a OMP_METADIRECTIVE tree node. It has a
> single operand (accessed by OMP_METADIRECTIVE_CLAUSES) which contains a

I think naming this OMP_METADIRECTIVE_CLAUSES when the operand isn't
a chain of OMP_CLAUSE trees is misleading, I think better would be
OMP_METADIRECTIVE_VARIANTS.

> I have removed support for the 'omp begin metadirective'..'omp end
> metadirective' form of the directive that was originally in the WIP patch.
> According to the spec, the only variant directives that can be used in this
> form must have an 'end <directive>' form (apart from the 'nothing'
> directive), and in C/C++, the only directive that we support with an end
> form is 'declare target', which we currently forbid since it is declarative.

I guess that is fine initially, but eventually we should have support
for parsing of omp begin metadirective and omp end metadirective even
if we just always sorry then.

> --- a/gcc/c/c-parser.c
> +++ b/gcc/c/c-parser.c
> @@ -1390,6 +1390,17 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
>  	  ++nesting_depth;
>  	  break;
>  
> +	case CPP_OPEN_PAREN:
> +	  /* Track parentheses in case the statement is a standalone 'for'
> +	     statement - we want to skip over the semicolons separating the
> +	     operands.  */
> +	  nesting_depth++;
> +	  break;
> +
> +	case CPP_CLOSE_PAREN:
> +	  nesting_depth--;
> +	  break;
> +
>  	case CPP_PRAGMA:
>  	  /* If we see a pragma, consume the whole thing at once.  We
>  	     have some safeguards against consuming pragmas willy-nilly.

I find this hunk very risky, it is used in many places and I'm not convinced
that is the behavior we want everywhere else.
I'd say the options are either to copy the function and add this only to the
copy and use that in metadirective handling, or add a default bool argument
and only do something about nesting_depth if the argument is non-default.
Furthermore, I don't think we want to just blindly decrement nesting_depth,
the CPP_CLOSE_BRACE takes care of never decrementing it below zero.
And, the function uses ++nesting_depth etc. instead of nesting_depth++
so some consistency would be nice.

> @@ -19187,6 +19200,7 @@ c_parser_omp_for_loop (location_t loc, c_parser *parser, enum tree_code code,
>    location_t for_loc;
>    bool tiling = false;
>    bool inscan = false;
> +
>    vec<tree, va_gc> *for_block = make_tree_vector ();
>  
>    for (cl = clauses; cl; cl = OMP_CLAUSE_CHAIN (cl))

Why?

> @@ -21606,10 +21621,16 @@ c_parser_omp_context_selector (c_parser *parser, tree set, tree parms)
>  		{
>  		  mark_exp_read (t);
>  		  t = c_fully_fold (t, false, NULL);
> -		  if (!INTEGRAL_TYPE_P (TREE_TYPE (t))
> -		      || !tree_fits_shwi_p (t))
> +		  if (!metadirective_p
> +		      && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
> +			  || !tree_fits_shwi_p (t)))
>  		    error_at (token->location, "property must be "
> -			      "constant integer expression");
> +					       "constant integer expression");
> +		  else if (metadirective_p
> +			   && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
> +		    /* Allow non-constant user expressions in metadirectives.  */
> +		    error_at (token->location, "property must be "
> +					       "integer expression");
>  		  else
>  		    properties = tree_cons (NULL_TREE, t, properties);
>  		}

I don't understand this change.  In OpenMP 5.0, condition selector had to be
constant.  In OpenMP 5.1, it can be non-constant and then it is a dynamic
selector.  But there is no restriction that it must be constant for
declare variant.
I think enabling this is orthogonal to the metadirective support, so either
the initial version shouldn't support dynamic selectors and a follow-up
patch should add support for them for both metadirectives and declare
variant, or the support should be added for both at the same time.

> @@ -22930,6 +22953,368 @@ c_parser_omp_error (c_parser *parser, enum pragma_context context)
>    return false;
>  }
>  
> +/* Helper function for c_parser_omp_metadirective.  */
> +
> +static void
> +analyze_metadirective_body (c_parser *parser,
> +			    vec<c_token> &tokens,
> +			    vec<tree> &labels)
> +{
> +  int nesting_depth = 0;
> +  int bracket_depth = 0;
> +  bool ignore_label = false;
> +
> +  /* Read in the body tokens to the tokens for each candidate directive.  */
> +  while (1)
> +    {
> +      c_token *token = c_parser_peek_token (parser);
> +      bool stop = false;
> +
> +      if (c_parser_next_token_is_keyword (parser, RID_CASE))
> +	ignore_label = true;
> +
> +      switch (token->type)
> +	{
> +	case CPP_EOF:
> +	  break;
> +	case CPP_NAME:
> +	  if (!ignore_label
> +	      && c_parser_peek_2nd_token (parser)->type == CPP_COLON)
> +	    labels.safe_push (token->value);

This looks risky, not all CPP_NAME CPP_COLON adjacent tokens will be
actually labels.
E.g. in
  { struct S { int a, b; } c = { a: 1, b: 2 }; }
a and b aren't labels.
I'm afraid we need real parsing to find out what is a label and what is not.
Or for C
  { void bar (void) { goto a; a:; } bar (); }
a is indeed a label, but in a nested function (for C++ e.g. in lambda)
and I doubt we want to privatize those either.
Gathering this way just potential label candidates and later marking only
those that were actually encountered during parsing might work.

> +c_parser_omp_metadirective (location_t loc, c_parser *parser,
> +			    char *p_name, omp_clause_mask, tree *,
> +			    bool *if_p)
> +{
> +  tree ret;
> +  auto_vec<c_token> directive_tokens;
> +  auto_vec<c_token> body_tokens;
> +  auto_vec<tree> body_labels;
> +  auto_vec<const struct c_omp_directive *> directives;
> +  auto_vec<tree> ctxs;
> +  vec<struct omp_metadirective_variant> candidates;
> +  bool default_seen = false;
> +  int directive_token_idx = 0;
> +  tree standalone_body = NULL_TREE;
> +
> +  ret = make_node (OMP_METADIRECTIVE);
> +  SET_EXPR_LOCATION (ret, loc);
> +  TREE_TYPE (ret) = void_type_node;
> +  OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
> +  strcat (p_name, " metadirective");
> +
> +  while (c_parser_next_token_is_not (parser, CPP_PRAGMA_EOL))
> +    {
> +      if (c_parser_next_token_is_not (parser, CPP_NAME)
> +	  && c_parser_next_token_is_not (parser, CPP_KEYWORD))
> +	{
> +	  c_parser_error (parser, "expected %<when%> or %<default%>");

Consistency would suggest
"expected %<#pragma omp%> clause"
or, if you want to spell those out,
"expected %<when%> or %<default%> clause"
But note that we'll need to add %<otherwise%> clause to the list soon
as an alias to %<default%>.

> +	  goto error;
> +	}
> +
> +      location_t match_loc = c_parser_peek_token (parser)->location;
> +      const char *p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
> +      c_parser_consume_token (parser);
> +      bool default_p = strcmp (p, "default") == 0;
> +      if (default_p)
> +	{
> +	  if (default_seen)
> +	    {
> +	      c_parser_error (parser, "there can only be one default clause "
> +				      "in a metadirective");

As I said elsewhere, "too many %qs clauses", "default"

> +	      goto error;
> +	    }
> +	  default_seen = true;
> +	}
> +      if (!(strcmp (p, "when") == 0 || default_p))
> +	{
> +	  c_parser_error (parser, "expected %<when%> or %<default%>");

Consistency would suggest
error_at (here, "%qs is not valid for %qs", p, "metadirective");

> +	  /* Remove the selector from further consideration if can be
> +	     evaluated as a non-match at this point.  */
> +	  skip = (omp_context_selector_matches (ctx, true) == 0);

The outer ()s aren't needed.

> +
> +	  if (c_parser_next_token_is_not (parser, CPP_COLON))
> +	    {
> +	      c_parser_error (parser, "expected colon");
> +	      goto error;
> +	    }

c_parser_require (parser, CPP_COLON, "expected %<:%>")
instead?  Or at least "expected %<:%>"

> +      /* Read in the directive type and create a dummy pragma token for
> +	 it.  */
> +      location_t loc = c_parser_peek_token (parser)->location;
> +
> +      p = NULL;
> +      if (c_parser_next_token_is (parser, CPP_CLOSE_PAREN))
> +	p = "nothing";
> +      else if (c_parser_next_token_is_keyword (parser, RID_FOR))
> +	{
> +	  p = "for";
> +	  c_parser_consume_token (parser);
> +	}
> +      else if (c_parser_next_token_is (parser, CPP_NAME))
> +	{
> +	  p = IDENTIFIER_POINTER (c_parser_peek_token (parser)->value);
> +	  c_parser_consume_token (parser);
> +	}
> +
> +      if (p == NULL)
> +	{
> +	  c_parser_error (parser, "expected directive name");
> +	  goto error;
> +	}
> +
> +      const struct c_omp_directive *omp_directive
> +	= c_omp_categorize_directive (p, NULL, NULL);

The NULL, NULL looks wrong.  I don't see how you'd handle
say when (whatever: target enter data) correctly then,
or any other multiple identifier directive.
You should simply peek (raw) at the next token after it and
if it is also a CPP_NAME, supply the other name, and in that
case look for the token even after it and if it is CPP_NAME, supply
that too.
            const char *directive[3] = {};
            for (int i = 0; i < 3; i++)
              {
                tree id = NULL_TREE;
                if (first + i == last)
                  break;
                if (first[i].type == CPP_NAME)
                  id = first[i].u.value;
                else if (first[i].type == CPP_KEYWORD)
                  id = ridpointers[(int) first[i].keyword];
                else
                  break;
                directive[i] = IDENTIFIER_POINTER (id);
              }
is what the C++ FE does.
> +
> +      if (omp_directive == NULL)
> +	{
> +	  c_parser_error (parser, "unknown directive name");
> +	  goto error;
> +	}
> +      if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
> +	{
> +	  c_parser_error (parser,
> +			  "metadirectives cannot be used as directive "
> +			  "variants");

"variants of a %<metadirective%>" ?

> +	  goto error;
> +	}
> +      if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
> +	{
> +	  sorry_at (loc, "declarative directive variants are not supported");

"declarative directive variants of a %<metadirective%> not supported" ?

> +  analyze_metadirective_body (parser, body_tokens, body_labels);

I think the code above this should determine if all the directives are
standalone/informational/utility and in that case don't try to analyze
any body, no?

> @@ -23043,7 +23433,6 @@ c_parser_omp_construct (c_parser *parser, bool *if_p)
>      gcc_assert (EXPR_LOCATION (stmt) != UNKNOWN_LOCATION);
>  }
>  
> -
>  /* OpenMP 2.5:
>     # pragma omp threadprivate (variable-list) */
>  

Why?

	Jakub

[PATCH 2/7] openmp: Add middle-end support for metadirectives

[Kwok Cheung Yeung]

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

This patch contains the required support for metadirectives in the 
middle-end.

The tree metadirective representation is gimplified into the high Gimple 
representation, which is structured like this:

#pragma omp metadirective
   when (<selector1>):
     <directive body 1>
     goto body_label|end_label
   when (<selector2>>:
     <directive body 2>
     goto body_label|end_label
   default:
     <directive body N>
     goto body_label|end_label
body_label:
   <standalone body>
end_label:

Each variant ends with an explicit goto to either the shared standalone 
body (if the variant uses it) or to the point after the body (if it does 
not).

When lowered to low Gimple, the directive bodies move outside of the 
metadirective statement, retaining only the labels to the bodies, so it 
looks like this instead:

#pragma omp metadirective
   when (<selector1>): goto body1_label
   when (<selector2>>: goto body2_label
   default: goto default_label
body1_label:
   <directive body 1>
   goto body_label|end_label
body2_label:
   <directive body 2>
   goto body_label|end_label
default_label:
   <directive body N>
   goto body_label|end_label
body_label:
   <standalone body>
end_label:

When scanning the OpenMP regions in the ompexp pass, we create a 'clone' 
of the surrounding context when recursively scanning the directive 
variants. If the same outer context was used for all variants, then it 
would appear as if all the variants were inside the region at the same 
time (only one variant of the metadirective is ever active at a time), 
which can lead to spurious errors.

The rest of the code is the plumbing required to allow the Gimple 
metadirective statement to pass through the middle-end. GCC will emit an 
ICE if it makes it through to the back-end though, as the metadirective 
is supposed to be eliminated before it gets that far.

Kwok

[-- Attachment #2: 0002-openmp-Add-middle-end-support-for-metadirectives.patch --]
[-- Type: text/plain, Size: 31056 bytes --]

From 1a2fcbb2191fd1dd694ea5730e54fab19d6465b4 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:29:34 +0000
Subject: [PATCH 2/7] openmp: Add middle-end support for metadirectives

This adds a new Gimple statement type GIMPLE_OMP_METADIRECTIVE, which
represents the metadirective in Gimple. In high Gimple, the statement
contains the body of the directive variants, whereas in low Gimple, it
only contains labels to the bodies.

This patch adds support for converting metadirectives from tree to Gimple
form, and handling of the Gimple form (Gimple lowering, OpenMP lowering
and expansion, inlining, SSA handling etc).

Metadirectives should be resolved before they reach the back-end, otherwise
the compiler will crash as GCC does not know how to convert metadirective
Gimple statements to RTX.

2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* gimple-low.c (lower_omp_metadirective): New.
	(lower_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
	* gimple-pretty-print.c (dump_gimple_omp_metadirective): New.
	(pp_gimple_stmt_1): Handle GIMPLE_OMP_METADIRECTIVE.
	* gimple-walk.c (walk_gimple_op): Handle GIMPLE_OMP_METADIRECTIVE.
	(walk_gimple_stmt): Likewise.
	* gimple.c (gimple_alloc_omp_metadirective): New.
	(gimple_build_omp_metadirective): New.
	(gimple_build_omp_metadirective_variant): New.
	* gimple.def (GIMPLE_OMP_METADIRECTIVE): New.
	(GIMPLE_OMP_METADIRECTIVE_VARIANT): New.
	* gimple.h (gomp_metadirective_variant): New.
	(gomp_metadirective): New.
	(is_a_helper <gomp_metadirective *>::test): New.
	(is_a_helper <gomp_metadirective_variant *>::test): New.
	(is_a_helper <const gomp_metadirective *>::test): New.
	(is_a_helper <const gomp_metadirective_variant *>::test): New.
	(gimple_alloc_omp_metadirective): New prototype.
	(gimple_build_omp_metadirective): New prototype.
	(gimple_build_omp_metadirective_variant): New prototype.
	(gimple_has_substatements): Add GIMPLE_OMP_METADIRECTIVE case.
	(gimple_has_ops): Add GIMPLE_OMP_METADIRECTIVE.
	(gimple_omp_metadirective_label): New.
	(gimple_omp_metadirective_set_label): New.
	(gimple_omp_metadirective_variants): New.
	(gimple_omp_metadirective_set_variants): New.
	(CASE_GIMPLE_OMP): Add GIMPLE_OMP_METADIRECTIVE.
	* gimplify.c (is_gimple_stmt): Add OMP_METADIRECTIVE.
	(expand_omp_metadirective): New.
	(gimplify_omp_metadirective): New.
	(gimplify_expr): Add case for OMP_METADIRECTIVE.
	* gsstruct.def (GSS_OMP_METADIRECTIVE): New.
	(GSS_OMP_METADIRECTIVE_VARIANT): New.
	* omp-expand.c (build_omp_regions_1): Handle GIMPLE_OMP_METADIRECTIVE.
	(omp_make_gimple_edges): Likewise.
	* omp-low.c (struct omp_context): Add next_clone field.
	(new_omp_context): Initialize next_clone field.
	(clone_omp_context): New.
	(delete_omp_context): Delete clone contexts.
	(scan_omp_metadirective): New.
	(scan_omp_1_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
	(lower_omp_metadirective): New.
	(lower_omp_1): Handle GIMPLE_OMP_METADIRECTIVE.
	* tree-cfg.c (cleanup_dead_labels): Handle GIMPLE_OMP_METADIRECTIVE.
	(gimple_redirect_edge_and_branch): Likewise.
	* tree-inline.c (remap_gimple_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
	(estimate_num_insns): Likewise.
	* tree-pretty-print.c (dump_generic_node): Handle OMP_METADIRECTIVE.
	* tree-ssa-operands.c (parse_ssa_operands): Handle
	GIMPLE_OMP_METADIRECTIVE.
---
 gcc/gimple-low.c          |  34 +++++++++++++
 gcc/gimple-pretty-print.c |  63 ++++++++++++++++++++++++
 gcc/gimple-walk.c         |  31 ++++++++++++
 gcc/gimple.c              |  35 +++++++++++++
 gcc/gimple.def            |   7 +++
 gcc/gimple.h              | 100 +++++++++++++++++++++++++++++++++++++-
 gcc/gimplify.c            |  94 +++++++++++++++++++++++++++++++++++
 gcc/gsstruct.def          |   2 +
 gcc/omp-expand.c          |  28 +++++++++++
 gcc/omp-low.c             |  66 +++++++++++++++++++++++++
 gcc/tree-cfg.c            |  24 +++++++++
 gcc/tree-inline.c         |  36 ++++++++++++++
 gcc/tree-pretty-print.c   |  34 +++++++++++++
 gcc/tree-ssa-operands.c   |  27 ++++++++++
 14 files changed, 580 insertions(+), 1 deletion(-)

diff --git a/gcc/gimple-low.c b/gcc/gimple-low.c
index 7e39c22df44..723c8b1d516 100644
--- a/gcc/gimple-low.c
+++ b/gcc/gimple-low.c
@@ -234,6 +234,34 @@ lower_omp_directive (gimple_stmt_iterator *gsi, struct lower_data *data)
   gsi_next (gsi);
 }
 
+/* Lower the OpenMP metadirective statement pointed by GSI.  */
+
+static void
+lower_omp_metadirective (gimple_stmt_iterator *gsi, struct lower_data *data)
+{
+  gimple *stmt = gsi_stmt (*gsi);
+  gimple *variant = gimple_omp_metadirective_variants (stmt);
+  unsigned i;
+
+  /* The variants are not used after lowering.  */
+  gimple_omp_metadirective_set_variants (stmt, NULL);
+
+  for (i = 0; i < gimple_num_ops (stmt); i++)
+    {
+      tree label = create_artificial_label (UNKNOWN_LOCATION);
+      gimple_omp_metadirective_set_label (stmt, i, label);
+      gsi_insert_after (gsi, gimple_build_label (label), GSI_CONTINUE_LINKING);
+
+      gimple_seq *directive_ptr = gimple_omp_body_ptr (variant);
+      lower_sequence (directive_ptr, data);
+      gsi_insert_seq_after (gsi, *directive_ptr, GSI_CONTINUE_LINKING);
+
+      variant = variant->next;
+    }
+
+  gsi_next (gsi);
+}
+
 
 /* Lower statement GSI.  DATA is passed through the recursion.  We try to
    track the fallthruness of statements and get rid of unreachable return
@@ -400,6 +428,12 @@ lower_stmt (gimple_stmt_iterator *gsi, struct lower_data *data)
       data->cannot_fallthru = false;
       return;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      data->cannot_fallthru = false;
+      lower_omp_metadirective (gsi, data);
+      data->cannot_fallthru = false;
+      return;
+
     case GIMPLE_TRANSACTION:
       lower_sequence (gimple_transaction_body_ptr (
 			as_a <gtransaction *> (stmt)),
diff --git a/gcc/gimple-pretty-print.c b/gcc/gimple-pretty-print.c
index 1cd1597359e..da263137f5b 100644
--- a/gcc/gimple-pretty-print.c
+++ b/gcc/gimple-pretty-print.c
@@ -2051,6 +2051,63 @@ dump_gimple_omp_return (pretty_printer *buffer, const gimple *gs, int spc,
     }
 }
 
+/* Dump a GIMPLE_OMP_METADIRECTIVE tuple on the pretty_printer BUFFER.  */
+
+static void
+dump_gimple_omp_metadirective (pretty_printer *buffer, const gimple *gs,
+			       int spc, dump_flags_t flags)
+{
+  if (flags & TDF_RAW)
+    {
+      dump_gimple_fmt (buffer, spc, flags, "%G <%+BODY <%S> >", gs,
+		       gimple_omp_body (gs));
+    }
+  else
+    {
+      pp_string (buffer, "#pragma omp metadirective");
+      newline_and_indent (buffer, spc + 2);
+
+      gimple *variant = gimple_omp_metadirective_variants (gs);
+
+      for (unsigned i = 0; i < gimple_num_ops (gs); i++)
+	{
+	  tree selector = gimple_op (gs, i);
+
+	  if (selector == NULL_TREE)
+	    pp_string (buffer, "default:");
+	  else
+	    {
+	      pp_string (buffer, "when (");
+	      dump_generic_node (buffer, selector, spc, flags, false);
+	      pp_string (buffer, "):");
+	    }
+
+	  if (variant != NULL)
+	    {
+	      newline_and_indent (buffer, spc + 4);
+	      pp_left_brace (buffer);
+	      pp_newline (buffer);
+	      dump_gimple_seq (buffer, gimple_omp_body (variant), spc + 6,
+			       flags);
+	      newline_and_indent (buffer, spc + 4);
+	      pp_right_brace (buffer);
+
+	      variant = variant->next;
+	    }
+	  else
+	    {
+	      tree label = gimple_omp_metadirective_label (gs, i);
+
+	      pp_string (buffer, " ");
+	      dump_generic_node (buffer, label, spc, flags, false);
+	    }
+
+	  if (i != gimple_num_ops (gs) - 1)
+	    newline_and_indent (buffer, spc + 2);
+	}
+    }
+}
+
 /* Dump a GIMPLE_TRANSACTION tuple on the pretty_printer BUFFER.  */
 
 static void
@@ -2823,6 +2880,12 @@ pp_gimple_stmt_1 (pretty_printer *buffer, const gimple *gs, int spc,
 				flags);
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      dump_gimple_omp_metadirective (buffer,
+				     as_a <const gomp_metadirective *> (gs),
+				     spc, flags);
+      break;
+
     case GIMPLE_CATCH:
       dump_gimple_catch (buffer, as_a <const gcatch *> (gs), spc, flags);
       break;
diff --git a/gcc/gimple-walk.c b/gcc/gimple-walk.c
index e15fd4697ba..b8db0fe34b2 100644
--- a/gcc/gimple-walk.c
+++ b/gcc/gimple-walk.c
@@ -485,6 +485,21 @@ walk_gimple_op (gimple *stmt, walk_tree_fn callback_op,
       }
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      {
+	gimple *variant = gimple_omp_metadirective_variants (stmt);
+
+	while (variant)
+	  {
+	    ret = walk_gimple_op (gimple_omp_body (variant), callback_op, wi);
+	    if (ret)
+	      return ret;
+
+	    variant = variant->next;
+	  }
+      }
+      break;
+
     case GIMPLE_TRANSACTION:
       {
 	gtransaction *txn = as_a <gtransaction *> (stmt);
@@ -700,6 +715,22 @@ walk_gimple_stmt (gimple_stmt_iterator *gsi, walk_stmt_fn callback_stmt,
 	return wi->callback_result;
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      {
+	gimple *variant = gimple_omp_metadirective_variants (stmt);
+
+	while (variant)
+	  {
+	    ret = walk_gimple_seq_mod (gimple_omp_body_ptr (variant),
+				       callback_stmt, callback_op, wi);
+	    if (ret)
+	      return wi->callback_result;
+
+	    variant = variant->next;
+	  }
+      }
+      break;
+
     case GIMPLE_WITH_CLEANUP_EXPR:
       ret = walk_gimple_seq_mod (gimple_wce_cleanup_ptr (stmt), callback_stmt,
 			     callback_op, wi);
diff --git a/gcc/gimple.c b/gcc/gimple.c
index 037c6e4c827..99f3a8de2ea 100644
--- a/gcc/gimple.c
+++ b/gcc/gimple.c
@@ -1267,6 +1267,41 @@ gimple_build_omp_atomic_store (tree val, enum omp_memory_order mo)
   return p;
 }
 
+/* Allocate extra memory for a GIMPLE_OMP_METADIRECTIVE statement.  */
+
+void
+gimple_alloc_omp_metadirective (gimple *g)
+{
+  gomp_metadirective *p = as_a <gomp_metadirective *> (g);
+
+  p->labels = ggc_cleared_vec_alloc<tree> (gimple_num_ops (p));
+}
+
+/* Build a GIMPLE_OMP_METADIRECTIVE statement.  */
+
+gomp_metadirective *
+gimple_build_omp_metadirective (int num_variants)
+{
+  gomp_metadirective *p
+    = as_a <gomp_metadirective *> (gimple_alloc (GIMPLE_OMP_METADIRECTIVE,
+						 num_variants));
+  gimple_alloc_omp_metadirective (p);
+  gimple_omp_metadirective_set_variants (p, NULL);
+
+  return p;
+}
+
+/* Build a GIMPLE_OMP_METADIRECTIVE_VARIANT statement.  */
+
+gomp_metadirective_variant *
+gimple_build_omp_metadirective_variant (gimple_seq body)
+{
+  gomp_metadirective_variant *variant = as_a <gomp_metadirective_variant *>
+    (gimple_alloc (GIMPLE_OMP_METADIRECTIVE_VARIANT, 0));
+  gimple_omp_set_body (variant, body);
+  return variant;
+}
+
 /* Build a GIMPLE_TRANSACTION statement.  */
 
 gtransaction *
diff --git a/gcc/gimple.def b/gcc/gimple.def
index 193b2506523..55ff9883193 100644
--- a/gcc/gimple.def
+++ b/gcc/gimple.def
@@ -393,6 +393,13 @@ DEFGSCODE(GIMPLE_OMP_TEAMS, "gimple_omp_teams", GSS_OMP_PARALLEL_LAYOUT)
    CLAUSES is an OMP_CLAUSE chain holding the associated clauses.  */
 DEFGSCODE(GIMPLE_OMP_ORDERED, "gimple_omp_ordered", GSS_OMP_SINGLE_LAYOUT)
 
+/* GIMPLE_OMP_METADIRECTIVE represents #pragma omp metadirective.  */
+DEFGSCODE(GIMPLE_OMP_METADIRECTIVE, "gimple_omp_metadirective",
+	  GSS_OMP_METADIRECTIVE)
+
+DEFGSCODE(GIMPLE_OMP_METADIRECTIVE_VARIANT,
+	  "gimple_omp_metadirective_variant", GSS_OMP_METADIRECTIVE_VARIANT)
+
 /* GIMPLE_PREDICT <PREDICT, OUTCOME> specifies a hint for branch prediction.
 
    PREDICT is one of the predictors from predict.def.
diff --git a/gcc/gimple.h b/gcc/gimple.h
index f7fdefc5362..8554d288e42 100644
--- a/gcc/gimple.h
+++ b/gcc/gimple.h
@@ -824,6 +824,30 @@ struct GTY((tag("GSS_OMP_ATOMIC_STORE_LAYOUT")))
          stmt->code == GIMPLE_OMP_RETURN.  */
 };
 
+struct GTY((tag("GSS_OMP_METADIRECTIVE_VARIANT")))
+  gomp_metadirective_variant : public gimple_statement_omp
+{
+  /* The body in the base class contains the directive for this variant.  */
+
+  /* No extra fields; adds invariant:
+       stmt->code == GIMPLE_OMP_METADIRECTIVE_VARIANT.  */};
+
+struct GTY((tag("GSS_OMP_METADIRECTIVE")))
+  gomp_metadirective : public gimple_statement_with_ops_base
+{
+  /* [ WORD 1-7 ] : base class */
+
+  /* [ WORD 8 ] : a list of bodies associated with the directive variants.  */
+  gomp_metadirective_variant *variants;
+
+  /* [ WORD 9 ] : label vector.  */
+  tree * GTY((length ("%h.num_ops"))) labels;
+
+  /* [ WORD 10 ] : operand vector.  Used to hold the selectors for the
+     directive variants.  */
+  tree GTY((length ("%h.num_ops"))) op[1];
+};
+
 /* GIMPLE_TRANSACTION.  */
 
 /* Bits to be stored in the GIMPLE_TRANSACTION subcode.  */
@@ -1235,6 +1259,22 @@ is_a_helper <gomp_task *>::test (gimple *gs)
   return gs->code == GIMPLE_OMP_TASK;
 }
 
+template <>
+template <>
+inline bool
+is_a_helper <gomp_metadirective *>::test (gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_METADIRECTIVE;
+}
+
+template <>
+template <>
+inline bool
+is_a_helper <gomp_metadirective_variant *>::test (gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_METADIRECTIVE_VARIANT;
+}
+
 template <>
 template <>
 inline bool
@@ -1477,6 +1517,22 @@ is_a_helper <const gomp_task *>::test (const gimple *gs)
   return gs->code == GIMPLE_OMP_TASK;
 }
 
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_metadirective *>::test (const gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_METADIRECTIVE;
+}
+
+template <>
+template <>
+inline bool
+is_a_helper <const gomp_metadirective_variant *>::test (const gimple *gs)
+{
+  return gs->code == GIMPLE_OMP_METADIRECTIVE_VARIANT;
+}
+
 template <>
 template <>
 inline bool
@@ -1576,6 +1632,9 @@ gomp_teams *gimple_build_omp_teams (gimple_seq, tree);
 gomp_atomic_load *gimple_build_omp_atomic_load (tree, tree,
 						enum omp_memory_order);
 gomp_atomic_store *gimple_build_omp_atomic_store (tree, enum omp_memory_order);
+void gimple_alloc_omp_metadirective (gimple *g);
+gomp_metadirective *gimple_build_omp_metadirective (int num_variants);
+gomp_metadirective_variant *gimple_build_omp_metadirective_variant (gimple_seq body);
 gtransaction *gimple_build_transaction (gimple_seq);
 extern void gimple_seq_add_stmt (gimple_seq *, gimple *);
 extern void gimple_seq_add_stmt_without_update (gimple_seq *, gimple *);
@@ -1853,6 +1912,7 @@ gimple_has_substatements (gimple *g)
     case GIMPLE_OMP_TARGET:
     case GIMPLE_OMP_TEAMS:
     case GIMPLE_OMP_CRITICAL:
+    case GIMPLE_OMP_METADIRECTIVE:
     case GIMPLE_WITH_CLEANUP_EXPR:
     case GIMPLE_TRANSACTION:
       return true;
@@ -2110,7 +2170,8 @@ gimple_init_singleton (gimple *g)
 static inline bool
 gimple_has_ops (const gimple *g)
 {
-  return gimple_code (g) >= GIMPLE_COND && gimple_code (g) <= GIMPLE_RETURN;
+  return (gimple_code (g) >= GIMPLE_COND && gimple_code (g) <= GIMPLE_RETURN)
+      || gimple_code (g) == GIMPLE_OMP_METADIRECTIVE;
 }
 
 template <>
@@ -6488,6 +6549,42 @@ gimple_omp_continue_set_control_use (gomp_continue *cont_stmt, tree use)
   cont_stmt->control_use = use;
 }
 
+
+static inline tree
+gimple_omp_metadirective_label (const gimple *g, unsigned i)
+{
+  const gomp_metadirective *omp_metadirective
+    = as_a <const gomp_metadirective *> (g);
+  return omp_metadirective->labels[i];
+}
+
+
+static inline void
+gimple_omp_metadirective_set_label (gimple *g, unsigned i, tree label)
+{
+  gomp_metadirective *omp_metadirective = as_a <gomp_metadirective *> (g);
+  omp_metadirective->labels[i] = label;
+}
+
+
+static inline gomp_metadirective_variant *
+gimple_omp_metadirective_variants (const gimple *g)
+{
+  const gomp_metadirective *omp_metadirective
+    = as_a <const gomp_metadirective *> (g);
+  return omp_metadirective->variants;
+}
+
+
+static inline void
+gimple_omp_metadirective_set_variants (gimple *g, gimple *variants)
+{
+  gomp_metadirective *omp_metadirective = as_a <gomp_metadirective *> (g);
+  omp_metadirective->variants
+    = variants ? as_a <gomp_metadirective_variant *> (variants) : NULL;
+}
+
+
 /* Return a pointer to the body for the GIMPLE_TRANSACTION statement
    TRANSACTION_STMT.  */
 
@@ -6638,6 +6735,7 @@ gimple_return_set_retval (greturn *gs, tree retval)
     case GIMPLE_OMP_RETURN:			\
     case GIMPLE_OMP_ATOMIC_LOAD:		\
     case GIMPLE_OMP_ATOMIC_STORE:		\
+    case GIMPLE_OMP_METADIRECTIVE:		\
     case GIMPLE_OMP_CONTINUE
 
 static inline bool
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index b118c72f62c..ed72162bb7f 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -5787,6 +5787,7 @@ is_gimple_stmt (tree t)
     case OMP_TASKGROUP:
     case OMP_ORDERED:
     case OMP_CRITICAL:
+    case OMP_METADIRECTIVE:
     case OMP_TASK:
     case OMP_TARGET:
     case OMP_TARGET_DATA:
@@ -14680,6 +14681,94 @@ gimplify_omp_ordered (tree expr, gimple_seq body)
   return gimple_build_omp_ordered (body, OMP_ORDERED_CLAUSES (expr));
 }
 
+/* Replace a metadirective with the candidate directive variants in
+   CANDIDATES.  */
+
+static enum gimplify_status
+expand_omp_metadirective (vec<struct omp_metadirective_variant> &,
+			  gimple_seq *)
+{
+  return GS_ERROR;
+}
+
+/* Gimplify an OMP_METADIRECTIVE construct.   EXPR is the tree version.
+   The metadirective will be resolved at this point if possible.  */
+
+static enum gimplify_status
+gimplify_omp_metadirective (tree *expr_p, gimple_seq *pre_p, gimple_seq *,
+			    bool (*) (tree), fallback_t)
+{
+  auto_vec<tree> selectors;
+
+  /* Try to resolve the metadirective.  */
+  vec<struct omp_metadirective_variant> candidates
+    = omp_resolve_metadirective (*expr_p);
+  if (!candidates.is_empty ())
+    return expand_omp_metadirective (candidates, pre_p);
+
+  /* The metadirective cannot be resolved yet.  */
+
+  gomp_metadirective_variant *first_variant = NULL;
+  gomp_metadirective_variant *prev_variant = NULL;
+  gimple_seq standalone_body = NULL;
+  tree body_label = NULL;
+  tree end_label = create_artificial_label (UNKNOWN_LOCATION);
+
+  for (tree clause = OMP_METADIRECTIVE_CLAUSES (*expr_p); clause != NULL_TREE;
+       clause = TREE_CHAIN (clause))
+    {
+      tree selector = TREE_PURPOSE (clause);
+      tree directive = TREE_PURPOSE (TREE_VALUE (clause));
+      tree body = TREE_VALUE (TREE_VALUE (clause));
+
+      selectors.safe_push (selector);
+      gomp_metadirective_variant *variant
+	= gimple_build_omp_metadirective_variant (NULL);
+      gimple_seq *directive_p = gimple_omp_body_ptr (variant);
+
+      gimplify_stmt (&directive, directive_p);
+      if (body != NULL_TREE)
+	{
+	  if (standalone_body == NULL)
+	    {
+	      gimplify_stmt (&body, &standalone_body);
+	      body_label = create_artificial_label (UNKNOWN_LOCATION);
+	    }
+	  gimplify_seq_add_stmt (directive_p, gimple_build_goto (body_label));
+	}
+      else
+	gimplify_seq_add_stmt (directive_p, gimple_build_goto (end_label));
+
+      if (!first_variant)
+	first_variant = variant;
+      if (prev_variant)
+	{
+	  prev_variant->next = variant;
+	  variant->prev = prev_variant;
+	}
+      prev_variant = variant;
+    }
+
+  gomp_metadirective *stmt
+    = gimple_build_omp_metadirective (selectors.length ());
+  gimple_omp_metadirective_set_variants (stmt, first_variant);
+
+  tree selector;
+  unsigned int i;
+  FOR_EACH_VEC_ELT (selectors, i, selector)
+    gimple_set_op (stmt, i, selector);
+
+  gimplify_seq_add_stmt (pre_p, stmt);
+  if (standalone_body)
+    {
+      gimplify_seq_add_stmt (pre_p, gimple_build_label (body_label));
+      gimplify_seq_add_stmt (pre_p, standalone_body);
+    }
+  gimplify_seq_add_stmt (pre_p, gimple_build_label (end_label));
+
+  return GS_ALL_DONE;
+}
+
 /* Convert the GENERIC expression tree *EXPR_P to GIMPLE.  If the
    expression produces a value to be used as an operand inside a GIMPLE
    statement, the value will be stored back in *EXPR_P.  This value will
@@ -15586,6 +15675,11 @@ gimplify_expr (tree *expr_p, gimple_seq *pre_p, gimple_seq *post_p,
 	  ret = gimplify_omp_atomic (expr_p, pre_p);
 	  break;
 
+	case OMP_METADIRECTIVE:
+	  ret = gimplify_omp_metadirective (expr_p, pre_p, post_p,
+					    gimple_test_f, fallback);
+	  break;
+
 	case TRANSACTION_EXPR:
 	  ret = gimplify_transaction (expr_p, pre_p);
 	  break;
diff --git a/gcc/gsstruct.def b/gcc/gsstruct.def
index 8f777e2bb95..ff10605baec 100644
--- a/gcc/gsstruct.def
+++ b/gcc/gsstruct.def
@@ -50,4 +50,6 @@ DEFGSSTRUCT(GSS_OMP_SINGLE_LAYOUT, gimple_statement_omp_single_layout, false)
 DEFGSSTRUCT(GSS_OMP_CONTINUE, gomp_continue, false)
 DEFGSSTRUCT(GSS_OMP_ATOMIC_LOAD, gomp_atomic_load, false)
 DEFGSSTRUCT(GSS_OMP_ATOMIC_STORE_LAYOUT, gomp_atomic_store, false)
+DEFGSSTRUCT(GSS_OMP_METADIRECTIVE, gomp_metadirective, true)
+DEFGSSTRUCT(GSS_OMP_METADIRECTIVE_VARIANT, gomp_metadirective_variant, false)
 DEFGSSTRUCT(GSS_TRANSACTION, gtransaction, false)
diff --git a/gcc/omp-expand.c b/gcc/omp-expand.c
index c5fa5a01aac..3bf81e1ae95 100644
--- a/gcc/omp-expand.c
+++ b/gcc/omp-expand.c
@@ -10418,6 +10418,10 @@ build_omp_regions_1 (basic_block bb, struct omp_region *parent,
 	  /* GIMPLE_OMP_SECTIONS_SWITCH is part of
 	     GIMPLE_OMP_SECTIONS, and we do nothing for it.  */
 	}
+      else if (code == GIMPLE_OMP_METADIRECTIVE)
+	{
+	  /* Do nothing for metadirectives.  */
+	}
       else
 	{
 	  region = new_omp_region (bb, code, parent);
@@ -10791,6 +10795,30 @@ omp_make_gimple_edges (basic_block bb, struct omp_region **region,
 	}
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      /* Create an edge to the beginning of the body of each candidate
+	 directive.  */
+      {
+	gimple *stmt = last_stmt (bb);
+	unsigned i;
+	bool seen_default = false;
+
+	for (i = 0; i < gimple_num_ops (stmt); i++)
+	  {
+	    tree dest = gimple_omp_metadirective_label (stmt, i);
+	    basic_block dest_bb = label_to_block (cfun, dest);
+	    make_edge (bb, dest_bb, 0);
+
+	    if (gimple_op (stmt, i) == NULL_TREE)
+	      seen_default = true;
+	  }
+
+	gcc_assert (seen_default);
+
+	fallthru = false;
+      }
+      break;
+
     default:
       gcc_unreachable ();
     }
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 2a07beb4eaf..accea81e8af 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -183,6 +183,10 @@ struct omp_context
 
   /* Candidates for adjusting OpenACC privatization level.  */
   vec<tree> oacc_privatization_candidates;
+
+  /* Only used for omp metadirectives.  Links to the next shallow
+     clone of this context.  */
+  struct omp_context *next_clone;
 };
 
 static splay_tree all_contexts;
@@ -985,6 +989,7 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
   splay_tree_insert (all_contexts, (splay_tree_key) stmt,
 		     (splay_tree_value) ctx);
   ctx->stmt = stmt;
+  ctx->next_clone = NULL;
 
   if (outer_ctx)
     {
@@ -1014,6 +1019,18 @@ new_omp_context (gimple *stmt, omp_context *outer_ctx)
   return ctx;
 }
 
+static omp_context *
+clone_omp_context (omp_context *ctx)
+{
+  omp_context *clone_ctx = XCNEW (omp_context);
+
+  memcpy (clone_ctx, ctx, sizeof (omp_context));
+  ctx->next_clone = clone_ctx;
+  clone_ctx->next_clone = NULL;
+
+  return clone_ctx;
+}
+
 static gimple_seq maybe_catch_exception (gimple_seq);
 
 /* Finalize task copyfn.  */
@@ -1060,6 +1077,15 @@ delete_omp_context (splay_tree_value value)
 {
   omp_context *ctx = (omp_context *) value;
 
+  /* Delete clones.  */
+  omp_context *clone = ctx->next_clone;
+  while (clone)
+    {
+      omp_context *next_clone = clone->next_clone;
+      XDELETE (clone);
+      clone = next_clone;
+    }
+
   delete ctx->cb.decl_map;
 
   if (ctx->field_map)
@@ -3091,6 +3117,24 @@ scan_omp_teams (gomp_teams *stmt, omp_context *outer_ctx)
     ctx->record_type = ctx->receiver_decl = NULL;
 }
 
+/* Scan an OpenMP metadirective.  */
+
+static void
+scan_omp_metadirective (gomp_metadirective *stmt, omp_context *outer_ctx)
+{
+  gomp_metadirective_variant *variant
+    = gimple_omp_metadirective_variants (stmt);
+
+  while (variant)
+    {
+      gimple_seq *directive_p = gimple_omp_body_ptr (variant);
+      omp_context *ctx = outer_ctx ? clone_omp_context (outer_ctx) : NULL;
+
+      scan_omp (directive_p, ctx);
+      variant = (gomp_metadirective_variant *) variant->next;
+    }
+}
+
 /* Check nesting restrictions.  */
 static bool
 check_omp_nesting_restrictions (gimple *stmt, omp_context *ctx)
@@ -4235,6 +4279,10 @@ scan_omp_1_stmt (gimple_stmt_iterator *gsi, bool *handled_ops_p,
 	scan_omp_teams (as_a <gomp_teams *> (stmt), ctx);
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      scan_omp_metadirective (as_a <gomp_metadirective *> (stmt), ctx);
+      break;
+
     case GIMPLE_BIND:
       {
 	tree var;
@@ -10654,6 +10702,21 @@ oacc_privatization_scan_decl_chain (omp_context *ctx, tree decls)
     }
 }
 
+static void
+lower_omp_metadirective (gimple_stmt_iterator *gsi_p, omp_context *ctx)
+{
+  gimple *stmt = gsi_stmt (*gsi_p);
+  gomp_metadirective_variant *variant
+    = gimple_omp_metadirective_variants (stmt);
+  while (variant)
+    {
+      gimple_seq *directive_p = gimple_omp_body_ptr (variant);
+      lower_omp (directive_p, ctx);
+
+      variant = (gomp_metadirective_variant *) (variant->next);
+    }
+}
+
 /* Callback for walk_gimple_seq.  Find #pragma omp scan statement.  */
 
 static tree
@@ -14230,6 +14293,9 @@ lower_omp_1 (gimple_stmt_iterator *gsi_p, omp_context *ctx)
       else
 	lower_omp_teams (gsi_p, ctx);
       break;
+    case GIMPLE_OMP_METADIRECTIVE:
+      lower_omp_metadirective (gsi_p, ctx);
+      break;
     case GIMPLE_CALL:
       tree fndecl;
       call_stmt = as_a <gcall *> (stmt);
diff --git a/gcc/tree-cfg.c b/gcc/tree-cfg.c
index ebbd894ae03..7066d9fb471 100644
--- a/gcc/tree-cfg.c
+++ b/gcc/tree-cfg.c
@@ -1670,6 +1670,18 @@ cleanup_dead_labels (void)
 	  }
 	  break;
 
+	case GIMPLE_OMP_METADIRECTIVE:
+	  {
+	    for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+	      {
+		label = gimple_omp_metadirective_label (stmt, i);
+		new_label = main_block_label (label, label_for_bb);
+		if (new_label != label)
+		  gimple_omp_metadirective_set_label (stmt, i, new_label);
+	      }
+	  }
+	  break;
+
 	default:
 	  break;
       }
@@ -6147,6 +6159,18 @@ gimple_redirect_edge_and_branch (edge e, basic_block dest)
 				           gimple_block_label (dest));
       break;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      {
+	for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+	  {
+	    tree label = gimple_omp_metadirective_label (stmt, i);
+	    if (label_to_block (cfun, label) == e->dest)
+	      gimple_omp_metadirective_set_label (stmt, i,
+						  gimple_block_label (dest));
+	  }
+      }
+      break;
+
     default:
       /* Otherwise it must be a fallthru edge, and we don't need to
 	 do anything besides redirecting it.  */
diff --git a/gcc/tree-inline.c b/gcc/tree-inline.c
index bc5ff0bb052..0f0035fef3b 100644
--- a/gcc/tree-inline.c
+++ b/gcc/tree-inline.c
@@ -1674,6 +1674,35 @@ remap_gimple_stmt (gimple *stmt, copy_body_data *id)
 		   (s1, gimple_omp_masked_clauses (stmt));
 	  break;
 
+	case GIMPLE_OMP_METADIRECTIVE:
+	  copy = gimple_build_omp_metadirective (gimple_num_ops (stmt));
+	  {
+	    gimple *first_variant = NULL;
+	    gimple **prev_next = &first_variant;
+	    for (gimple *variant = gimple_omp_metadirective_variants (stmt);
+		 variant; variant = variant->next)
+	      {
+		s1 = remap_gimple_seq (gimple_omp_body (variant), id);
+		gimple *new_variant
+		  = gimple_build_omp_metadirective_variant (s1);
+
+		*prev_next = new_variant;
+		prev_next = &new_variant->next;
+	      }
+	    gimple_omp_metadirective_set_variants (copy, first_variant);
+	  }
+
+	  memset (&wi, 0, sizeof (wi));
+	  wi.info = id;
+	  for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+	    {
+	      tree label = gimple_omp_metadirective_label (stmt, i);
+	      walk_tree (&label, remap_gimple_op_r, &wi, NULL);
+	      gimple_omp_metadirective_set_label (copy, i, label);
+	      gimple_set_op (copy, i, gimple_op (stmt, i));
+	    }
+	  break;
+
 	case GIMPLE_OMP_SCOPE:
 	  s1 = remap_gimple_seq (gimple_omp_body (stmt), id);
 	  copy = gimple_build_omp_scope
@@ -4590,6 +4619,13 @@ estimate_num_insns (gimple *stmt, eni_weights *weights)
       return (weights->omp_cost
               + estimate_num_insns_seq (gimple_omp_body (stmt), weights));
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      /* The actual instruction will disappear eventually, so metadirective
+	 statements have zero additional cost (if only static selectors
+	 are used).  */
+      /* TODO: Estimate the cost of evaluating dynamic selectors  */
+      return 0;
+
     case GIMPLE_TRANSACTION:
       return (weights->tm_cost
 	      + estimate_num_insns_seq (gimple_transaction_body (
diff --git a/gcc/tree-pretty-print.c b/gcc/tree-pretty-print.c
index a81ba401ef9..eb45f7d6bdf 100644
--- a/gcc/tree-pretty-print.c
+++ b/gcc/tree-pretty-print.c
@@ -3751,6 +3751,40 @@ dump_generic_node (pretty_printer *pp, tree node, int spc, dump_flags_t flags,
       is_expr = false;
       break;
 
+    case OMP_METADIRECTIVE:
+      {
+	pp_string (pp, "#pragma omp metadirective");
+	newline_and_indent (pp, spc + 2);
+	pp_left_brace (pp);
+
+	tree clause = OMP_METADIRECTIVE_CLAUSES (node);
+	while (clause != NULL_TREE)
+	  {
+	    newline_and_indent (pp, spc + 4);
+	    if (TREE_PURPOSE (clause) == NULL_TREE)
+	      pp_string (pp, "default:");
+	    else
+	      {
+		pp_string (pp, "when (");
+		dump_generic_node (pp, TREE_PURPOSE (clause), spc + 4, flags,
+				   false);
+		pp_string (pp, "):");
+	      }
+	    newline_and_indent (pp, spc + 6);
+
+	    tree variant = TREE_VALUE (clause);
+	    dump_generic_node (pp, TREE_PURPOSE (variant), spc + 6, flags,
+			       false);
+	    newline_and_indent (pp, spc + 6);
+	    dump_generic_node (pp, TREE_VALUE (variant), spc + 6, flags,
+			       false);
+	    clause = TREE_CHAIN (clause);
+	  }
+	newline_and_indent (pp, spc + 2);
+	pp_right_brace (pp);
+      }
+      break;
+
     case TRANSACTION_EXPR:
       if (TRANSACTION_EXPR_OUTER (node))
 	pp_string (pp, "__transaction_atomic [[outer]]");
diff --git a/gcc/tree-ssa-operands.c b/gcc/tree-ssa-operands.c
index ebf7eea3b04..d17e4144df7 100644
--- a/gcc/tree-ssa-operands.c
+++ b/gcc/tree-ssa-operands.c
@@ -973,6 +973,33 @@ operands_scanner::parse_ssa_operands ()
       append_vuse (gimple_vop (fn));
       goto do_default;
 
+    case GIMPLE_OMP_METADIRECTIVE:
+      n = gimple_num_ops (stmt);
+      for (i = start; i < n; i++)
+	{
+	  for (tree selector = gimple_op (stmt, i);
+	       selector != NULL;
+	       selector = TREE_CHAIN (selector))
+	    {
+	      if (TREE_PURPOSE (selector) == get_identifier ("user"))
+		{
+		  for (tree property = TREE_VALUE (selector);
+		       property != NULL;
+		       property = TREE_CHAIN (property))
+		    if (TREE_PURPOSE (property)
+			== get_identifier ("condition"))
+		      {
+			for (tree condition = TREE_VALUE (property);
+			     condition != NULL;
+			     condition = TREE_CHAIN (condition))
+			  get_expr_operands (&TREE_VALUE (condition),
+					     opf_use);
+		      }
+		}
+	    }
+	}
+      break;
+
     case GIMPLE_CALL:
       /* Add call-clobbered operands, if needed.  */
       maybe_add_call_vops (as_a <gcall *> (stmt));
-- 
2.25.1

Re: [PATCH 2/7] openmp: Add middle-end support for metadirectives

[Jakub Jelinek]

On Fri, Dec 10, 2021 at 05:33:25PM +0000, Kwok Cheung Yeung wrote:
> 2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>
> 
> 	gcc/
> 	* gimple-low.c (lower_omp_metadirective): New.
> 	(lower_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
> 	* gimple-pretty-print.c (dump_gimple_omp_metadirective): New.
> 	(pp_gimple_stmt_1): Handle GIMPLE_OMP_METADIRECTIVE.
> 	* gimple-walk.c (walk_gimple_op): Handle GIMPLE_OMP_METADIRECTIVE.
> 	(walk_gimple_stmt): Likewise.
> 	* gimple.c (gimple_alloc_omp_metadirective): New.
> 	(gimple_build_omp_metadirective): New.
> 	(gimple_build_omp_metadirective_variant): New.
> 	* gimple.def (GIMPLE_OMP_METADIRECTIVE): New.
> 	(GIMPLE_OMP_METADIRECTIVE_VARIANT): New.
> 	* gimple.h (gomp_metadirective_variant): New.
> 	(gomp_metadirective): New.
> 	(is_a_helper <gomp_metadirective *>::test): New.
> 	(is_a_helper <gomp_metadirective_variant *>::test): New.
> 	(is_a_helper <const gomp_metadirective *>::test): New.
> 	(is_a_helper <const gomp_metadirective_variant *>::test): New.
> 	(gimple_alloc_omp_metadirective): New prototype.
> 	(gimple_build_omp_metadirective): New prototype.
> 	(gimple_build_omp_metadirective_variant): New prototype.
> 	(gimple_has_substatements): Add GIMPLE_OMP_METADIRECTIVE case.
> 	(gimple_has_ops): Add GIMPLE_OMP_METADIRECTIVE.
> 	(gimple_omp_metadirective_label): New.
> 	(gimple_omp_metadirective_set_label): New.
> 	(gimple_omp_metadirective_variants): New.
> 	(gimple_omp_metadirective_set_variants): New.
> 	(CASE_GIMPLE_OMP): Add GIMPLE_OMP_METADIRECTIVE.
> 	* gimplify.c (is_gimple_stmt): Add OMP_METADIRECTIVE.
> 	(expand_omp_metadirective): New.
> 	(gimplify_omp_metadirective): New.
> 	(gimplify_expr): Add case for OMP_METADIRECTIVE.
> 	* gsstruct.def (GSS_OMP_METADIRECTIVE): New.
> 	(GSS_OMP_METADIRECTIVE_VARIANT): New.
> 	* omp-expand.c (build_omp_regions_1): Handle GIMPLE_OMP_METADIRECTIVE.
> 	(omp_make_gimple_edges): Likewise.
> 	* omp-low.c (struct omp_context): Add next_clone field.
> 	(new_omp_context): Initialize next_clone field.
> 	(clone_omp_context): New.
> 	(delete_omp_context): Delete clone contexts.
> 	(scan_omp_metadirective): New.
> 	(scan_omp_1_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
> 	(lower_omp_metadirective): New.
> 	(lower_omp_1): Handle GIMPLE_OMP_METADIRECTIVE.
> 	* tree-cfg.c (cleanup_dead_labels): Handle GIMPLE_OMP_METADIRECTIVE.
> 	(gimple_redirect_edge_and_branch): Likewise.
> 	* tree-inline.c (remap_gimple_stmt): Handle GIMPLE_OMP_METADIRECTIVE.
> 	(estimate_num_insns): Likewise.
> 	* tree-pretty-print.c (dump_generic_node): Handle OMP_METADIRECTIVE.
> 	* tree-ssa-operands.c (parse_ssa_operands): Handle
> 	GIMPLE_OMP_METADIRECTIVE.

> --- a/gcc/gimple-pretty-print.c
> +++ b/gcc/gimple-pretty-print.c
> @@ -2051,6 +2051,63 @@ dump_gimple_omp_return (pretty_printer *buffer, const gimple *gs, int spc,
>      }
>  }
>  
> +/* Dump a GIMPLE_OMP_METADIRECTIVE tuple on the pretty_printer BUFFER.  */
> +
> +static void
> +dump_gimple_omp_metadirective (pretty_printer *buffer, const gimple *gs,
> +			       int spc, dump_flags_t flags)
> +{
> +  if (flags & TDF_RAW)
> +    {
> +      dump_gimple_fmt (buffer, spc, flags, "%G <%+BODY <%S> >", gs,
> +		       gimple_omp_body (gs));
> +    }

No need for {}s around a single statement.

> +  else
> +    {
> +      pp_string (buffer, "#pragma omp metadirective");
> +      newline_and_indent (buffer, spc + 2);
> +
> +      gimple *variant = gimple_omp_metadirective_variants (gs);
> +
> +      for (unsigned i = 0; i < gimple_num_ops (gs); i++)
> +	{
> +	  tree selector = gimple_op (gs, i);
> +
> +	  if (selector == NULL_TREE)
> +	    pp_string (buffer, "default:");
> +	  else
> +	    {
> +	      pp_string (buffer, "when (");
> +	      dump_generic_node (buffer, selector, spc, flags, false);
> +	      pp_string (buffer, "):");
> +	    }
> +
> +	  if (variant != NULL)
> +	    {
> +	      newline_and_indent (buffer, spc + 4);
> +	      pp_left_brace (buffer);
> +	      pp_newline (buffer);
> +	      dump_gimple_seq (buffer, gimple_omp_body (variant), spc + 6,
> +			       flags);
> +	      newline_and_indent (buffer, spc + 4);
> +	      pp_right_brace (buffer);
> +
> +	      variant = variant->next;
> +	    }
> +	  else
> +	    {
> +	      tree label = gimple_omp_metadirective_label (gs, i);
> +
> +	      pp_string (buffer, " ");
> +	      dump_generic_node (buffer, label, spc, flags, false);
> +	    }
> +
> +	  if (i != gimple_num_ops (gs) - 1)
> +	    newline_and_indent (buffer, spc + 2);

I think better would be to use a gimple_stmt_iterator to walk the variants,
so no variant->next etc., but gimple_omp_metadirective_variants returning
a gimple_seq instead of gimple * (it is the same thing under the hood),
then
      gimple_seq variant_seq = gimple_omp_metadirective_variants (gs);
      gimple_stmt_iterator gsi = gsi_start (variant_seq);
and in the loop
	  gimple *variant = gsi_stmt (gsi);
and gsi_next (&gsi); at the end.  Similarly for all other spots that walk
gimple_omp_metadirective_variants.


> +    case GIMPLE_OMP_METADIRECTIVE:
> +      {
> +	gimple *variant = gimple_omp_metadirective_variants (stmt);
> +
> +	while (variant)
> +	  {
> +	    ret = walk_gimple_op (gimple_omp_body (variant), callback_op, wi);
> +	    if (ret)
> +	      return ret;
> +
> +	    variant = variant->next;
> +	  }

So here too...

> +      }
> +      break;
> +
>      case GIMPLE_TRANSACTION:
>        {
>  	gtransaction *txn = as_a <gtransaction *> (stmt);
> @@ -700,6 +715,22 @@ walk_gimple_stmt (gimple_stmt_iterator *gsi, walk_stmt_fn callback_stmt,
>  	return wi->callback_result;
>        break;
>  
> +    case GIMPLE_OMP_METADIRECTIVE:
> +      {
> +	gimple *variant = gimple_omp_metadirective_variants (stmt);
> +
> +	while (variant)
> +	  {
> +	    ret = walk_gimple_seq_mod (gimple_omp_body_ptr (variant),
> +				       callback_stmt, callback_op, wi);
> +	    if (ret)
> +	      return wi->callback_result;
> +
> +	    variant = variant->next;
> +	  }

and here etc.
> --- a/gcc/omp-expand.c
> +++ b/gcc/omp-expand.c
> @@ -10418,6 +10418,10 @@ build_omp_regions_1 (basic_block bb, struct omp_region *parent,
>  	  /* GIMPLE_OMP_SECTIONS_SWITCH is part of
>  	     GIMPLE_OMP_SECTIONS, and we do nothing for it.  */
>  	}
> +      else if (code == GIMPLE_OMP_METADIRECTIVE)
> +	{
> +	  /* Do nothing for metadirectives.  */
> +	}

No {}s around the comment, just /* ...  */;

> --- a/gcc/tree-cfg.c
> +++ b/gcc/tree-cfg.c
> @@ -1670,6 +1670,18 @@ cleanup_dead_labels (void)
>  	  }
>  	  break;
>  
> +	case GIMPLE_OMP_METADIRECTIVE:
> +	  {
> +	    for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
> +	      {
> +		label = gimple_omp_metadirective_label (stmt, i);
> +		new_label = main_block_label (label, label_for_bb);
> +		if (new_label != label)
> +		  gimple_omp_metadirective_set_label (stmt, i, new_label);
> +	      }
> +	  }
> +	  break;

Why the {} around the for?

> @@ -6147,6 +6159,18 @@ gimple_redirect_edge_and_branch (edge e, basic_block dest)
>  				           gimple_block_label (dest));
>        break;
>  
> +    case GIMPLE_OMP_METADIRECTIVE:
> +      {
> +	for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
> +	  {
> +	    tree label = gimple_omp_metadirective_label (stmt, i);
> +	    if (label_to_block (cfun, label) == e->dest)
> +	      gimple_omp_metadirective_set_label (stmt, i,
> +						  gimple_block_label (dest));
> +	  }
> +      }
> +      break;

Likewise.

> --- a/gcc/tree-ssa-operands.c
> +++ b/gcc/tree-ssa-operands.c
> @@ -973,6 +973,33 @@ operands_scanner::parse_ssa_operands ()
>        append_vuse (gimple_vop (fn));
>        goto do_default;
>  
> +    case GIMPLE_OMP_METADIRECTIVE:
> +      n = gimple_num_ops (stmt);
> +      for (i = start; i < n; i++)
> +	{

Why the {}s around the inner for?

> +	  for (tree selector = gimple_op (stmt, i);
> +	       selector != NULL;
> +	       selector = TREE_CHAIN (selector))
> +	    {

Why the {}s around the if ?

> +	      if (TREE_PURPOSE (selector) == get_identifier ("user"))
> +		{
> +		  for (tree property = TREE_VALUE (selector);
> +		       property != NULL;
> +		       property = TREE_CHAIN (property))
> +		    if (TREE_PURPOSE (property)
> +			== get_identifier ("condition"))
> +		      {
> +			for (tree condition = TREE_VALUE (property);
> +			     condition != NULL;
> +			     condition = TREE_CHAIN (condition))
> +			  get_expr_operands (&TREE_VALUE (condition),
> +					     opf_use);
> +		      }
> +		}
> +	    }
> +	}
> +      break;
> +

Also, I wonder how does LTO saving/restoring handle the
GIMPLE_OMP_METADIRECTIVE statements.

Otherwise LGTM.

	Jakub

[PATCH 3/7] openmp: Add support for resolving metadirectives during parsing and Gimplification

[Kwok Cheung Yeung]

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

This patch contains code to resolve metadirectives, either during 
parsing or Gimplification.

The dynamic candidate selection algorithm from the OpenMP 5.1 spec is 
implemented in omp_get_dynamic_candidates in omp-general.c, which 
returns a vector containing information on the top-scoring candidate 
variants. The vector always consists of entries with dynamic selectors 
first, followed by a single entry with an all-static selector (which can 
be the default clause if all the other clauses are dynamic). If all 
selectors are static (i.e. OpenMP 5.0), then omp_get_dynamic_candidates 
will return a vector of at most length 1.

If any part of the selectors in the candidate list cannot be resolved at 
the current stage of compilation, an empty list is returned. Note that 
it is possible to resolve metadirectives even with some selectors 
unresolvable as long as those selectors are not part of the candidate list.

omp_context_selector_matches should always return 1 for dynamic 
selectors (since we can generate code to evaluate the condition at any 
time). omp_dynamic_cond, when given a selector, should return just the 
part of it that must be evaluated at run-time.

Metadirectives are resolved in both tree and Gimple form by generating a 
sequence of if..then..else statements that evaluate the dynamic selector 
of each candidate returned from omp_get_dynamic_candidates in order, 
jumping to the directive body if true, to the next evaluation if not.

Kwok

[-- Attachment #2: 0003-openmp-Add-support-for-resolving-metadirectives-duri.patch --]
[-- Type: text/plain, Size: 16738 bytes --]

From 65ee7342256db3c81cc6741ce2c96e36dd4a9ca6 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:49:23 +0000
Subject: [PATCH 3/7] openmp: Add support for resolving metadirectives during
 parsing and Gimplification

This adds support for resolving metadirectives according to the OpenMP 5.1
specification.  The variants are sorted by score, then gathered into a list
of dynamic replacement candidates.  The metadirective is then expanded into
a sequence of 'if..else' statements to test the dynamic selector and execute
the variant if the selector is satisfied.

If any of the selectors in the list are unresolvable, GCC will give up on
resolving the metadirective and try again later.

2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* gimplify.c (expand_omp_metadirective): New.
	* omp-general.c: Include tree-pretty-print.h.
	(DELAY_METADIRECTIVES_AFTER_LTO): New macro.
	(omp_context_selector_matches): Delay resolution of selectors.  Allow
	non-constant expressions.
	(omp_dynamic_cond): New.
	(omp_dynamic_selector_p): New.
	(sort_variant): New.
	(omp_get_dynamic_candidates): New.
	(omp_resolve_metadirective): New.
	(omp_resolve_metadirective): New.
	* omp-general.h (struct omp_metadirective_variant): New.
	(omp_resolve_metadirective): New prototype.

	gcc/c-family/
	* c-omp.c (c_omp_expand_metadirective_r): New.
	(c_omp_expand_metadirective): New.
---
 gcc/c-family/c-omp.c |  45 ++++++++-
 gcc/gimplify.c       |  72 +++++++++++++-
 gcc/omp-general.c    | 232 ++++++++++++++++++++++++++++++++++++++++++-
 gcc/omp-general.h    |   7 ++
 4 files changed, 346 insertions(+), 10 deletions(-)

diff --git a/gcc/c-family/c-omp.c b/gcc/c-family/c-omp.c
index 9a7a6834f1b..fedaec566ee 100644
--- a/gcc/c-family/c-omp.c
+++ b/gcc/c-family/c-omp.c
@@ -3264,8 +3264,49 @@ c_omp_categorize_directive (const char *first, const char *second,
   return NULL;
 }
 
+static tree
+c_omp_expand_metadirective_r (vec<struct omp_metadirective_variant> &candidates,
+			      hash_map<tree, tree> &body_labels,
+			      unsigned index)
+{
+  struct omp_metadirective_variant &candidate = candidates[index];
+  tree if_block = push_stmt_list ();
+  if (candidate.directive != NULL_TREE)
+    add_stmt (candidate.directive);
+  if (candidate.body != NULL_TREE)
+    {
+      tree *label = body_labels.get (candidate.body);
+      if (label != NULL)
+	add_stmt (build1 (GOTO_EXPR, void_type_node, *label));
+      else
+	{
+	  tree body_label = create_artificial_label (UNKNOWN_LOCATION);
+	  add_stmt (build1 (LABEL_EXPR, void_type_node, body_label));
+	  add_stmt (candidate.body);
+	  body_labels.put (candidate.body, body_label);
+	}
+    }
+  if_block = pop_stmt_list (if_block);
+
+  if (index == candidates.length () - 1)
+    return if_block;
+
+  tree cond = candidate.selector;
+  gcc_assert (cond != NULL_TREE);
+
+  tree else_block = c_omp_expand_metadirective_r (candidates, body_labels,
+						  index + 1);
+  tree ret = push_stmt_list ();
+  tree stmt = build3 (COND_EXPR, void_type_node, cond, if_block, else_block);
+  add_stmt (stmt);
+  ret = pop_stmt_list (ret);
+
+  return ret;
+}
+
 tree
-c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &)
+c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &candidates)
 {
-  return NULL_TREE;
+  hash_map<tree, tree> body_labels;
+  return c_omp_expand_metadirective_r (candidates, body_labels, 0);
 }
diff --git a/gcc/gimplify.c b/gcc/gimplify.c
index ed72162bb7f..5d9aa2c2145 100644
--- a/gcc/gimplify.c
+++ b/gcc/gimplify.c
@@ -14685,10 +14685,76 @@ gimplify_omp_ordered (tree expr, gimple_seq body)
    CANDIDATES.  */
 
 static enum gimplify_status
-expand_omp_metadirective (vec<struct omp_metadirective_variant> &,
-			  gimple_seq *)
+expand_omp_metadirective (vec<struct omp_metadirective_variant> &candidates,
+			  gimple_seq *pre_p)
 {
-  return GS_ERROR;
+  auto_vec<tree> selectors;
+  auto_vec<tree> directive_labels;
+  auto_vec<gimple_seq> directive_bodies;
+  tree body_label = NULL_TREE;
+  tree end_label = create_artificial_label (UNKNOWN_LOCATION);
+
+  /* Construct bodies for each candidate.  */
+  for (unsigned i = 0; i < candidates.length(); i++)
+    {
+      struct omp_metadirective_variant &candidate = candidates[i];
+      gimple_seq body = NULL;
+
+      selectors.safe_push (candidate.selector);
+      directive_labels.safe_push (create_artificial_label (UNKNOWN_LOCATION));
+
+      gimplify_seq_add_stmt (&body,
+			     gimple_build_label (directive_labels.last ()));
+      if (candidate.directive != NULL_TREE)
+	gimplify_stmt (&candidate.directive, &body);
+      if (candidate.body != NULL_TREE)
+	{
+	  if (body_label != NULL_TREE)
+	    gimplify_seq_add_stmt (&body, gimple_build_goto (body_label));
+	  else
+	    {
+	      body_label = create_artificial_label (UNKNOWN_LOCATION);
+	      gimplify_seq_add_stmt (&body, gimple_build_label (body_label));
+	      gimplify_stmt (&candidate.body, &body);
+	    }
+	}
+
+      directive_bodies.safe_push (body);
+    }
+
+  auto_vec<tree> cond_labels;
+
+  cond_labels.safe_push (NULL_TREE);
+  for (unsigned i = 1; i < candidates.length () - 1; i++)
+    cond_labels.safe_push (create_artificial_label (UNKNOWN_LOCATION));
+  if (candidates.length () > 1)
+    cond_labels.safe_push (directive_labels.last ());
+
+  /* Generate conditionals to test each dynamic selector in turn, executing
+     the directive candidate if successful.  */
+  for (unsigned i = 0; i < candidates.length () - 1; i++)
+    {
+      if (i != 0)
+	gimplify_seq_add_stmt (pre_p, gimple_build_label (cond_labels [i]));
+
+      enum gimplify_status ret = gimplify_expr (&selectors[i], pre_p, NULL,
+						is_gimple_val, fb_rvalue);
+      if (ret == GS_ERROR || ret == GS_UNHANDLED)
+	return ret;
+
+      gcond *cond_stmt
+	= gimple_build_cond_from_tree (selectors[i], directive_labels[i],
+				       cond_labels[i + 1]);
+
+      gimplify_seq_add_stmt (pre_p, cond_stmt);
+      gimplify_seq_add_seq (pre_p, directive_bodies[i]);
+      gimplify_seq_add_stmt (pre_p, gimple_build_goto (end_label));
+    }
+
+  gimplify_seq_add_seq (pre_p, directive_bodies.last ());
+  gimplify_seq_add_stmt (pre_p, gimple_build_label (end_label));
+
+  return GS_ALL_DONE;
 }
 
 /* Gimplify an OMP_METADIRECTIVE construct.   EXPR is the tree version.
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 9926cfd9d5f..6340d1600a6 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -45,6 +45,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "data-streamer.h"
 #include "streamer-hooks.h"
 #include "opts.h"
+#include "tree-pretty-print.h"
 
 enum omp_requires omp_requires_mask;
 
@@ -1253,14 +1254,22 @@ omp_context_name_list_prop (tree prop)
     }
 }
 
+#define DELAY_METADIRECTIVES_AFTER_LTO { \
+  if (metadirective_p && !(cfun->curr_properties & PROP_gimple_lomp_dev))	\
+    return -1;	\
+}
+
 /* Return 1 if context selector matches the current OpenMP context, 0
    if it does not and -1 if it is unknown and need to be determined later.
    Some properties can be checked right away during parsing (this routine),
    others need to wait until the whole TU is parsed, others need to wait until
-   IPA, others until vectorization.  */
+   IPA, others until vectorization.
+
+   Dynamic properties (which are evaluated at run-time) should always
+   return 1.  */
 
 int
-omp_context_selector_matches (tree ctx, bool)
+omp_context_selector_matches (tree ctx, bool metadirective_p)
 {
   int ret = 1;
   for (tree t1 = ctx; t1; t1 = TREE_CHAIN (t1))
@@ -1381,6 +1390,8 @@ omp_context_selector_matches (tree ctx, bool)
 		    const char *arch = omp_context_name_list_prop (t3);
 		    if (arch == NULL)
 		      return 0;
+		    DELAY_METADIRECTIVES_AFTER_LTO;
+
 		    int r = 0;
 		    if (targetm.omp.device_kind_arch_isa != NULL)
 		      r = targetm.omp.device_kind_arch_isa (omp_device_arch,
@@ -1505,6 +1516,8 @@ omp_context_selector_matches (tree ctx, bool)
 #endif
 			continue;
 		      }
+		    DELAY_METADIRECTIVES_AFTER_LTO;
+
 		    int r = 0;
 		    if (targetm.omp.device_kind_arch_isa != NULL)
 		      r = targetm.omp.device_kind_arch_isa (omp_device_kind,
@@ -1544,6 +1557,8 @@ omp_context_selector_matches (tree ctx, bool)
 		    const char *isa = omp_context_name_list_prop (t3);
 		    if (isa == NULL)
 		      return 0;
+		    DELAY_METADIRECTIVES_AFTER_LTO;
+
 		    int r = 0;
 		    if (targetm.omp.device_kind_arch_isa != NULL)
 		      r = targetm.omp.device_kind_arch_isa (omp_device_isa,
@@ -1595,6 +1610,12 @@ omp_context_selector_matches (tree ctx, bool)
 		for (tree t3 = TREE_VALUE (t2); t3; t3 = TREE_CHAIN (t3))
 		  if (TREE_PURPOSE (t3) == NULL_TREE)
 		    {
+		      /* OpenMP 5.1 allows non-constant conditions for
+			 metadirectives.  */
+		      if (metadirective_p
+			  && !tree_fits_shwi_p (TREE_VALUE (t3)))
+			break;
+
 		      if (integer_zerop (TREE_VALUE (t3)))
 			return 0;
 		      if (integer_nonzerop (TREE_VALUE (t3)))
@@ -1610,6 +1631,8 @@ omp_context_selector_matches (tree ctx, bool)
   return ret;
 }
 
+#undef DELAY_METADIRECTIVES_AFTER_LTO
+
 /* Compare construct={simd} CLAUSES1 with CLAUSES2, return 0/-1/1/2 as
    in omp_context_selector_set_compare.  */
 
@@ -1967,6 +1990,32 @@ omp_get_context_selector (tree ctx, const char *set, const char *sel)
   return NULL_TREE;
 }
 
+/* Return a tree expression representing the dynamic part of the context
+ * selector CTX.  */
+
+static tree
+omp_dynamic_cond (tree ctx)
+{
+  tree user = omp_get_context_selector (ctx, "user", "condition");
+  if (user)
+    {
+      tree expr_list = TREE_VALUE (user);
+
+      gcc_assert (TREE_PURPOSE (expr_list) == NULL_TREE);
+      return TREE_VALUE (expr_list);
+    }
+  return NULL_TREE;
+}
+
+/* Return true iff the context selector CTX contains a dynamic element
+   that cannot be resolved at compile-time.  */
+
+static bool
+omp_dynamic_selector_p (tree ctx)
+{
+  return omp_dynamic_cond (ctx) != NULL_TREE;
+}
+
 /* Compute *SCORE for context selector CTX.  Return true if the score
    would be different depending on whether it is a declare simd clone or
    not.  DECLARE_SIMD should be true for the case when it would be
@@ -2624,16 +2673,189 @@ omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
 						 INSERT) = entryp;
 }
 
+static int
+sort_variant (const void * a, const void *b, void *)
+{
+  widest_int score1 = ((const struct omp_metadirective_variant *) a)->score;
+  widest_int score2 = ((const struct omp_metadirective_variant *) b)->score;
+
+  if (score1 > score2)
+    return -1;
+  else if (score1 < score2)
+    return 1;
+  else
+    return 0;
+}
+
+/* Return a vector of dynamic replacement candidates for the directive
+   candidates in ALL_VARIANTS.  Return an empty vector if the metadirective
+   cannot be resolved.  */
+
+static vec<struct omp_metadirective_variant>
+omp_get_dynamic_candidates (vec <struct omp_metadirective_variant> &all_variants)
+{
+  auto_vec <struct omp_metadirective_variant> variants;
+  struct omp_metadirective_variant default_variant;
+  bool default_found = false;
+
+  for (unsigned int i = 0; i < all_variants.length (); i++)
+    {
+      struct omp_metadirective_variant variant = all_variants[i];
+
+      if (all_variants[i].selector == NULL_TREE)
+	{
+	  default_found = true;
+	  default_variant = all_variants[i];
+	  default_variant.score = 0;
+	  default_variant.resolvable_p = true;
+	  default_variant.dynamic_p = false;
+	  continue;
+	}
+
+      variant.resolvable_p = true;
+
+      if (dump_file)
+	{
+	  fprintf (dump_file, "Considering selector ");
+	  print_generic_expr (dump_file, variant.selector);
+	  fprintf (dump_file, " as candidate - ");
+	}
+
+      switch (omp_context_selector_matches (variant.selector, true))
+	{
+	case -1:
+	  variant.resolvable_p = false;
+	  if (dump_file)
+	    fprintf (dump_file, "unresolvable");
+	  /* FALLTHRU */
+	case 1:
+	  /* TODO: Handle SIMD score?.  */
+	  omp_context_compute_score (variant.selector, &variant.score, false);
+	  variant.dynamic_p = omp_dynamic_selector_p (variant.selector);
+	  variants.safe_push (variant);
+	  break;
+	case 0:
+	  if (dump_file)
+	    fprintf (dump_file, "no match");
+	  break;
+	}
+
+      if (dump_file)
+	fprintf (dump_file, "\n");
+    }
+
+  /* There must be one default variant.  */
+  gcc_assert (default_found);
+
+  /* A context selector that is a strict subset of another context selector
+     has a score of zero.  */
+  for (unsigned int i = 0; i < variants.length (); i++)
+    for (unsigned int j = i + 1; j < variants.length (); j++)
+      {
+	int r = omp_context_selector_compare (variants[i].selector,
+					      variants[j].selector);
+	if (r == -1)
+	  {
+	    /* variant1 is a strict subset of variant2.  */
+	    variants[i].score = 0;
+	    break;
+	  }
+	else if (r == 1)
+	  /* variant2 is a strict subset of variant1.  */
+	  variants[j].score = 0;
+      }
+
+  /* Sort the variants by decreasing score, preserving the original order
+     in case of a tie.  */
+  variants.stablesort (sort_variant, NULL);
+
+  /* Add the default as a final choice.  */
+  variants.safe_push (default_variant);
+
+  /* Build the dynamic candidate list.  */
+  for (unsigned i = 0; i < variants.length (); i++)
+    {
+      /* If one of the candidates is unresolvable, give up for now.  */
+      if (!variants[i].resolvable_p)
+	{
+	  variants.truncate (0);
+	  break;
+	}
+
+      /* Replace the original selector with just the dynamic part.  */
+      variants[i].selector = omp_dynamic_cond (variants[i].selector);
+
+      if (dump_file)
+	{
+	  fprintf (dump_file, "Adding directive variant with ");
+
+	  if (variants[i].selector)
+	    {
+	      fprintf (dump_file, "selector ");
+	      print_generic_expr (dump_file, variants[i].selector);
+	    }
+	  else
+	    fprintf (dump_file, "default selector");
+
+	  fprintf (dump_file, " as candidate.\n");
+	}
+
+      /* The last of the candidates is ended by a static selector.  */
+      if (!variants[i].dynamic_p)
+	{
+	  variants.truncate (i + 1);
+	  break;
+	}
+    }
+
+  return variants.copy ();
+}
+
 /* Return a vector of dynamic replacement candidates for the metadirective
    statement in METADIRECTIVE.  Return an empty vector if the metadirective
    cannot be resolved.  */
 
 vec<struct omp_metadirective_variant>
-omp_resolve_metadirective (tree)
+omp_resolve_metadirective (tree metadirective)
+{
+  auto_vec <struct omp_metadirective_variant> variants;
+  tree clause = OMP_METADIRECTIVE_CLAUSES (metadirective);
+
+  while (clause)
+    {
+      struct omp_metadirective_variant variant;
+
+      variant.selector = TREE_PURPOSE (clause);
+      variant.directive = TREE_PURPOSE (TREE_VALUE (clause));
+      variant.body = TREE_VALUE (TREE_VALUE (clause));
+
+      variants.safe_push (variant);
+      clause = TREE_CHAIN (clause);
+    }
+
+  return omp_get_dynamic_candidates (variants);
+}
+
+/* Return a vector of dynamic replacement candidates for the metadirective
+   Gimple statement in GS.  Return an empty vector if the metadirective
+   cannot be resolved.  */
+
+vec<struct omp_metadirective_variant>
+omp_resolve_metadirective (gimple *gs)
 {
-  vec<struct omp_metadirective_variant> variants = {};
+  auto_vec <struct omp_metadirective_variant> variants;
+
+  for (unsigned i = 0; i < gimple_num_ops (gs); i++)
+    {
+      struct omp_metadirective_variant variant;
+
+      variant.selector = gimple_op (gs, i);
+      variant.directive	= gimple_omp_metadirective_label (gs, i);
+
+      variants.safe_push (variant);
+    }
 
-  return variants;
+  return omp_get_dynamic_candidates (variants);
 }
 
 /* Encode an oacc launch argument.  This matches the GOMP_LAUNCH_PACK
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index 8c6009e9854..5a0747b2791 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -93,6 +93,12 @@ struct omp_for_data
 
 struct omp_metadirective_variant
 {
+  widest_int score;
+  tree selector;
+  tree directive;
+  tree body;
+  bool dynamic_p : 1;
+  bool resolvable_p : 1;
 };
 
 #define OACC_FN_ATTRIB "oacc function"
@@ -119,6 +125,7 @@ extern int omp_context_selector_set_compare (const char *, tree, tree);
 extern tree omp_get_context_selector (tree, const char *, const char *);
 extern tree omp_resolve_declare_variant (tree);
 extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (tree);
+extern vec<struct omp_metadirective_variant> omp_resolve_metadirective (gimple *);
 extern tree oacc_launch_pack (unsigned code, tree device, unsigned op);
 extern tree oacc_replace_fn_attrib_attr (tree attribs, tree dims);
 extern void oacc_replace_fn_attrib (tree fn, tree dims);
-- 
2.25.1

Re: [PATCH 3/7] openmp: Add support for resolving metadirectives during parsing and Gimplification

[Jakub Jelinek]

On Fri, Dec 10, 2021 at 05:35:05PM +0000, Kwok Cheung Yeung wrote:
> 2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>
> 
> 	gcc/
> 	* gimplify.c (expand_omp_metadirective): New.
> 	* omp-general.c: Include tree-pretty-print.h.
> 	(DELAY_METADIRECTIVES_AFTER_LTO): New macro.
> 	(omp_context_selector_matches): Delay resolution of selectors.  Allow
> 	non-constant expressions.
> 	(omp_dynamic_cond): New.
> 	(omp_dynamic_selector_p): New.
> 	(sort_variant): New.
> 	(omp_get_dynamic_candidates): New.
> 	(omp_resolve_metadirective): New.
> 	(omp_resolve_metadirective): New.
> 	* omp-general.h (struct omp_metadirective_variant): New.
> 	(omp_resolve_metadirective): New prototype.
> 
> 	gcc/c-family/
> 	* c-omp.c (c_omp_expand_metadirective_r): New.
> 	(c_omp_expand_metadirective): New.

> --- a/gcc/c-family/c-omp.c
> +++ b/gcc/c-family/c-omp.c
> @@ -3264,8 +3264,49 @@ c_omp_categorize_directive (const char *first, const char *second,
>    return NULL;
>  }
>  

Missing function comment.

> +static tree
> +c_omp_expand_metadirective_r (vec<struct omp_metadirective_variant> &candidates,
> +			      hash_map<tree, tree> &body_labels,
> +			      unsigned index)
> +{
> +  struct omp_metadirective_variant &candidate = candidates[index];
> +  tree if_block = push_stmt_list ();
> +  if (candidate.directive != NULL_TREE)
> +    add_stmt (candidate.directive);
> +  if (candidate.body != NULL_TREE)
> +    {
> +      tree *label = body_labels.get (candidate.body);
> +      if (label != NULL)
> +	add_stmt (build1 (GOTO_EXPR, void_type_node, *label));
> +      else
> +	{
> +	  tree body_label = create_artificial_label (UNKNOWN_LOCATION);
> +	  add_stmt (build1 (LABEL_EXPR, void_type_node, body_label));
> +	  add_stmt (candidate.body);
> +	  body_labels.put (candidate.body, body_label);
> +	}
> +    }
> +  if_block = pop_stmt_list (if_block);
> +
> +  if (index == candidates.length () - 1)
> +    return if_block;
> +
> +  tree cond = candidate.selector;
> +  gcc_assert (cond != NULL_TREE);
> +
> +  tree else_block = c_omp_expand_metadirective_r (candidates, body_labels,
> +						  index + 1);
> +  tree ret = push_stmt_list ();
> +  tree stmt = build3 (COND_EXPR, void_type_node, cond, if_block, else_block);
> +  add_stmt (stmt);
> +  ret = pop_stmt_list (ret);
> +
> +  return ret;
> +}
> +

Likewise.

>  tree
> -c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &)
> +c_omp_expand_metadirective (vec<struct omp_metadirective_variant> &candidates)
>  {
> -  return NULL_TREE;
> +  hash_map<tree, tree> body_labels;
> +  return c_omp_expand_metadirective_r (candidates, body_labels, 0);
>  }

> --- a/gcc/omp-general.c
> +++ b/gcc/omp-general.c
> @@ -45,6 +45,7 @@ along with GCC; see the file COPYING3.  If not see
>  #include "data-streamer.h"
>  #include "streamer-hooks.h"
>  #include "opts.h"
> +#include "tree-pretty-print.h"
>  
>  enum omp_requires omp_requires_mask;
>  
> @@ -1253,14 +1254,22 @@ omp_context_name_list_prop (tree prop)
>      }
>  }
>  
> +#define DELAY_METADIRECTIVES_AFTER_LTO { \
> +  if (metadirective_p && !(cfun->curr_properties & PROP_gimple_lomp_dev))	\
> +    return -1;	\

Why this?  Is that just some testing hack (which then the choice of
selectors in the testsuite relies on)?  I don't see why those selectors
shouldn't be resolved as early as possible.

> @@ -2624,16 +2673,189 @@ omp_lto_input_declare_variant_alt (lto_input_block *ib, cgraph_node *node,
>  						 INSERT) = entryp;
>  }
>  

Missing function comment.

> +static int
> +sort_variant (const void * a, const void *b, void *)
> +{
> +  widest_int score1 = ((const struct omp_metadirective_variant *) a)->score;
> +  widest_int score2 = ((const struct omp_metadirective_variant *) b)->score;
> +
> +  if (score1 > score2)
> +    return -1;
> +  else if (score1 < score2)
> +    return 1;
> +  else
> +    return 0;
> +}

Note, resolving at the end of parsing (during gimplification) is still not
during parsing.  For resolving during parsing we'll need another mode, in
which the FEs somehow track e.g. selected OpenMP constructs that surround
the code being currently parsed.  Obviously that can be handled
incrementally.

	Jakub

[PATCH 4/7] openmp: Add support for streaming metadirectives and resolving them after LTO

[Kwok Cheung Yeung]

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

This patch adds support for streaming the Gimple metadirective 
representation during LTO. An extra pass (also using 
omp_get_dynamic_candidates) is also added to resolve metadirectives 
after LTO, which is required for selectors that need to be resolved on 
the accel compiler.

Kwok

[-- Attachment #2: 0004-openmp-Add-support-for-streaming-metadirectives-and-.patch --]
[-- Type: text/plain, Size: 10464 bytes --]

From 85826d05e029571fd003dd629aa04ce3e17d9c71 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:56:07 +0000
Subject: [PATCH 4/7] openmp: Add support for streaming metadirectives and
 resolving them after LTO

This patch adds support for streaming metadirective Gimple statements during
LTO, and adds a metadirective expansion pass that runs after LTO.  This is
required for metadirectives with selectors that can only be resolved from
within the accel compiler.

2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* Makefile.in (OBJS): Add omp-expand-metadirective.o.
	* gimple-streamer-in.c (input_gimple_stmt): Add case for
	GIMPLE_OMP_METADIRECTIVE.  Handle metadirective labels.
	* gimple-streamer-out.c (output_gimple_stmt): Likewise.
	* omp-expand-metadirective.cc: New.
	* passes.def: Add pass_omp_expand_metadirective.
	* tree-pass.h (make_pass_omp_expand_metadirective): New prototype.
---
 gcc/Makefile.in                 |   1 +
 gcc/gimple-streamer-in.c        |  10 ++
 gcc/gimple-streamer-out.c       |   6 +
 gcc/omp-expand-metadirective.cc | 191 ++++++++++++++++++++++++++++++++
 gcc/passes.def                  |   1 +
 gcc/tree-pass.h                 |   1 +
 6 files changed, 210 insertions(+)
 create mode 100644 gcc/omp-expand-metadirective.cc

diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index 2a0be9e66a6..34a17f36922 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -1519,6 +1519,7 @@ OBJS = \
 	omp-oacc-kernels-decompose.o \
 	omp-oacc-neuter-broadcast.o \
 	omp-simd-clone.o \
+	omp-expand-metadirective.o \
 	opt-problem.o \
 	optabs.o \
 	optabs-libfuncs.o \
diff --git a/gcc/gimple-streamer-in.c b/gcc/gimple-streamer-in.c
index 1c979f438a5..b821aa3ca30 100644
--- a/gcc/gimple-streamer-in.c
+++ b/gcc/gimple-streamer-in.c
@@ -151,6 +151,7 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
     case GIMPLE_COND:
     case GIMPLE_GOTO:
     case GIMPLE_DEBUG:
+    case GIMPLE_OMP_METADIRECTIVE:
       for (i = 0; i < num_ops; i++)
 	{
 	  tree *opp, op = stream_read_tree (ib, data_in);
@@ -188,6 +189,15 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
 	  else
 	    gimple_call_set_fntype (call_stmt, stream_read_tree (ib, data_in));
 	}
+      if (gomp_metadirective *metadirective_stmt
+	    = dyn_cast <gomp_metadirective*> (stmt))
+	{
+	  gimple_alloc_omp_metadirective (metadirective_stmt);
+	  for (i = 0; i < num_ops; i++)
+	    gimple_omp_metadirective_set_label (metadirective_stmt, i,
+						stream_read_tree (ib,
+								  data_in));
+	}
       break;
 
     case GIMPLE_NOP:
diff --git a/gcc/gimple-streamer-out.c b/gcc/gimple-streamer-out.c
index fcbf92300d4..c19dff74261 100644
--- a/gcc/gimple-streamer-out.c
+++ b/gcc/gimple-streamer-out.c
@@ -127,6 +127,7 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
     case GIMPLE_COND:
     case GIMPLE_GOTO:
     case GIMPLE_DEBUG:
+    case GIMPLE_OMP_METADIRECTIVE:
       for (i = 0; i < gimple_num_ops (stmt); i++)
 	{
 	  tree op = gimple_op (stmt, i);
@@ -169,6 +170,11 @@ output_gimple_stmt (struct output_block *ob, struct function *fn, gimple *stmt)
 	  else
 	    stream_write_tree (ob, gimple_call_fntype (stmt), true);
 	}
+      if (gimple_code (stmt) == GIMPLE_OMP_METADIRECTIVE)
+	for (i = 0; i < gimple_num_ops (stmt); i++)
+	  stream_write_tree (ob, gimple_omp_metadirective_label (stmt, i),
+			     true);
+
       break;
 
     case GIMPLE_NOP:
diff --git a/gcc/omp-expand-metadirective.cc b/gcc/omp-expand-metadirective.cc
new file mode 100644
index 00000000000..aaf048a699a
--- /dev/null
+++ b/gcc/omp-expand-metadirective.cc
@@ -0,0 +1,191 @@
+/* Expand an OpenMP metadirective.
+
+   Copyright (C) 2021 Free Software Foundation, Inc.
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "backend.h"
+#include "target.h"
+#include "tree.h"
+#include "langhooks.h"
+#include "gimple.h"
+#include "tree-pass.h"
+#include "cgraph.h"
+#include "fold-const.h"
+#include "gimplify.h"
+#include "gimple-iterator.h"
+#include "gimple-walk.h"
+#include "gomp-constants.h"
+#include "omp-general.h"
+#include "diagnostic-core.h"
+#include "tree-cfg.h"
+#include "cfganal.h"
+#include "ssa.h"
+#include "tree-into-ssa.h"
+#include "cfghooks.h"
+
+static void
+omp_expand_metadirective (function *fun, basic_block bb)
+{
+  gimple *stmt = last_stmt (bb);
+  vec<struct omp_metadirective_variant> candidates
+    = omp_resolve_metadirective (stmt);
+
+  /* This is the last chance for the metadirective to be resolved.  */
+  if (candidates.is_empty ())
+    gcc_unreachable ();
+
+  auto_vec<tree> labels;
+
+  for (unsigned int i = 0; i < candidates.length (); i++)
+    labels.safe_push (candidates[i].directive);
+
+  /* Delete BBs for all variants not in the candidate list.  */
+  for (unsigned i = 0; i < gimple_num_ops (stmt); i++)
+    {
+      tree label = gimple_omp_metadirective_label (stmt, i);
+      if (!labels.contains (label))
+	{
+	  edge e = find_edge (bb, label_to_block (fun, label));
+	  remove_edge_and_dominated_blocks (e);
+	}
+    }
+
+  /* Remove the metadirective statement.  */
+  gimple_stmt_iterator gsi = gsi_last_bb (bb);
+  gsi_remove (&gsi, true);
+
+  if (candidates.length () == 1)
+    {
+      /* Special case if there is only one selector - there should be one
+	 remaining edge from BB to the selected variant.  */
+      edge e = find_edge (bb, label_to_block (fun,
+					      candidates.last ().directive));
+      e->flags |= EDGE_FALLTHRU;
+
+      return;
+    }
+
+  basic_block cur_bb = bb;
+
+  /* For each candidate, create a conditional that checks the dynamic
+     condition, branching to the candidate directive if true, to the
+     next candidate check if false.  */
+  for (unsigned i = 0; i < candidates.length () - 1; i++)
+    {
+      basic_block next_bb = NULL;
+      gcond *cond_stmt = gimple_build_cond_from_tree (candidates[i].selector,
+						      NULL_TREE, NULL_TREE);
+      gsi = gsi_last_bb (cur_bb);
+      gsi_insert_seq_after (&gsi, cond_stmt, GSI_NEW_STMT);
+
+      if (i < candidates.length () - 2)
+	{
+	  edge e_false = split_block (cur_bb, cond_stmt);
+	  e_false->flags &= ~EDGE_FALLTHRU;
+	  e_false->flags |= EDGE_FALSE_VALUE;
+	  e_false->probability = profile_probability::uninitialized ();
+
+	  next_bb = e_false->dest;
+	}
+
+      /* Redirect the source of the edge from BB to the candidate directive
+	 to the conditional.  Reusing the edge avoids disturbing phi nodes in
+	  the destination BB.  */
+      edge e = find_edge (bb, label_to_block (fun, candidates[i].directive));
+      redirect_edge_pred (e, cur_bb);
+      e->flags |= EDGE_TRUE_VALUE;
+
+      if (next_bb)
+	cur_bb = next_bb;
+    }
+
+  /* The last of the candidates is always static.  */
+  edge e = find_edge (cur_bb, label_to_block (fun,
+					      candidates.last ().directive));
+  e->flags |= EDGE_FALSE_VALUE;
+}
+
+namespace {
+
+const pass_data pass_data_omp_expand_metadirective =
+{
+  GIMPLE_PASS, /* type */
+  "omp_expand_metadirective", /* name */
+  OPTGROUP_OMP, /* optinfo_flags */
+  TV_NONE, /* tv_id */
+  PROP_gimple_lcf, /* properties_required */
+  0, /* properties_provided */
+  0, /* properties_destroyed */
+  0, /* todo_flags_start */
+  TODO_update_ssa | TODO_cleanup_cfg, /* todo_flags_finish */
+};
+
+class pass_omp_expand_metadirective : public gimple_opt_pass
+{
+public:
+  pass_omp_expand_metadirective (gcc::context *ctxt)
+    : gimple_opt_pass (pass_data_omp_expand_metadirective, ctxt)
+  {}
+
+  /* opt_pass methods: */
+  virtual bool gate (function *)
+  {
+    return (flag_openmp);
+  }
+
+  virtual unsigned int execute (function *fun);
+}; // class pass_omp_oacc_kernels_decompose
+
+unsigned int
+pass_omp_expand_metadirective::execute (function *fun)
+{
+  basic_block bb;
+  auto_vec<basic_block> metadirective_bbs;
+
+  FOR_EACH_BB_FN (bb, fun)
+    {
+      gimple *stmt = last_stmt (bb);
+      if (stmt && is_a<gomp_metadirective *> (stmt))
+	metadirective_bbs.safe_push (bb);
+    }
+
+  if (metadirective_bbs.is_empty ())
+    return 0;
+
+  calculate_dominance_info (CDI_DOMINATORS);
+
+  for (unsigned i = 0; i < metadirective_bbs.length (); i++)
+    omp_expand_metadirective (fun, metadirective_bbs[i]);
+
+  free_dominance_info (fun, CDI_DOMINATORS);
+  mark_virtual_operands_for_renaming (fun);
+
+  return 0;
+}
+
+} // anon namespace
+
+
+gimple_opt_pass *
+make_pass_omp_expand_metadirective (gcc::context *ctxt)
+{
+  return new pass_omp_expand_metadirective (ctxt);
+}
diff --git a/gcc/passes.def b/gcc/passes.def
index 37ea0d318d1..b80a53c4051 100644
--- a/gcc/passes.def
+++ b/gcc/passes.def
@@ -189,6 +189,7 @@ along with GCC; see the file COPYING3.  If not see
   NEXT_PASS (pass_oacc_device_lower);
   NEXT_PASS (pass_omp_device_lower);
   NEXT_PASS (pass_omp_target_link);
+  NEXT_PASS (pass_omp_expand_metadirective);
   NEXT_PASS (pass_adjust_alignment);
   NEXT_PASS (pass_all_optimizations);
   PUSH_INSERT_PASSES_WITHIN (pass_all_optimizations)
diff --git a/gcc/tree-pass.h b/gcc/tree-pass.h
index 3559c3c9f1b..e4315e2fe85 100644
--- a/gcc/tree-pass.h
+++ b/gcc/tree-pass.h
@@ -422,6 +422,7 @@ extern gimple_opt_pass *make_pass_lower_switch_O0 (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_lower_vector (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_lower_vector_ssa (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_omp_oacc_kernels_decompose (gcc::context *ctxt);
+extern gimple_opt_pass *make_pass_omp_expand_metadirective (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_lower_omp (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_diagnose_omp_blocks (gcc::context *ctxt);
 extern gimple_opt_pass *make_pass_expand_omp (gcc::context *ctxt);
-- 
2.25.1

Re: [PATCH 4/7] openmp: Add support for streaming metadirectives and resolving them after LTO

[Jakub Jelinek]

On Fri, Dec 10, 2021 at 05:36:20PM +0000, Kwok Cheung Yeung wrote:
> 2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>
> 
> 	gcc/
> 	* Makefile.in (OBJS): Add omp-expand-metadirective.o.
> 	* gimple-streamer-in.c (input_gimple_stmt): Add case for
> 	GIMPLE_OMP_METADIRECTIVE.  Handle metadirective labels.
> 	* gimple-streamer-out.c (output_gimple_stmt): Likewise.
> 	* omp-expand-metadirective.cc: New.
> 	* passes.def: Add pass_omp_expand_metadirective.
> 	* tree-pass.h (make_pass_omp_expand_metadirective): New prototype.
> ---
>  gcc/Makefile.in                 |   1 +
>  gcc/gimple-streamer-in.c        |  10 ++
>  gcc/gimple-streamer-out.c       |   6 +
>  gcc/omp-expand-metadirective.cc | 191 ++++++++++++++++++++++++++++++++
>  gcc/passes.def                  |   1 +
>  gcc/tree-pass.h                 |   1 +
>  6 files changed, 210 insertions(+)
>  create mode 100644 gcc/omp-expand-metadirective.cc
> 
> @@ -151,6 +151,7 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
>      case GIMPLE_COND:
>      case GIMPLE_GOTO:
>      case GIMPLE_DEBUG:
> +    case GIMPLE_OMP_METADIRECTIVE:
>        for (i = 0; i < num_ops; i++)
>  	{
>  	  tree *opp, op = stream_read_tree (ib, data_in);
> @@ -188,6 +189,15 @@ input_gimple_stmt (class lto_input_block *ib, class data_in *data_in,
>  	  else
>  	    gimple_call_set_fntype (call_stmt, stream_read_tree (ib, data_in));
>  	}
> +      if (gomp_metadirective *metadirective_stmt
> +	    = dyn_cast <gomp_metadirective*> (stmt))
> +	{
> +	  gimple_alloc_omp_metadirective (metadirective_stmt);
> +	  for (i = 0; i < num_ops; i++)
> +	    gimple_omp_metadirective_set_label (metadirective_stmt, i,
> +						stream_read_tree (ib,
> +								  data_in));
> +	}

Ah, sorry for the comment about LTO streaming, here it is.

> --- /dev/null
> +++ b/gcc/omp-expand-metadirective.cc
> @@ -0,0 +1,191 @@
> +/* Expand an OpenMP metadirective.
> +
> +   Copyright (C) 2021 Free Software Foundation, Inc.

We have 2022 now...
> +

Missing function comment.
> +static void
> +omp_expand_metadirective (function *fun, basic_block bb)
> +{
> +  gimple *stmt = last_stmt (bb);
> +  vec<struct omp_metadirective_variant> candidates
> +    = omp_resolve_metadirective (stmt);
> +
> +  /* This is the last chance for the metadirective to be resolved.  */
> +  if (candidates.is_empty ())
> +    gcc_unreachable ();

  gcc_assert (!candidates.is_empty ());
?

> +  /* opt_pass methods: */
> +  virtual bool gate (function *)
> +  {
> +    return (flag_openmp);

Useless ()s around it.
But much more importantly, I don't really like this to be a separate pass,
walking the whole IL once more is expensive, even when you restrict it
to just flag_openmp.
Late declare variant resolving is done in the (now a little bit misnamed)
pass_omp_device_lower.
The gate of that pass is right now:
      return (!(fun->curr_properties & PROP_gimple_lomp_dev)
              || (flag_openmp
                  && cgraph_node::get (fun->decl)->calls_declare_variant_alt));
so it would be nice to track (conservatively)
whether current function has any metadirectives
in it which aren't yet resolved (but perhaps the calls_declare_variant_alt
bit could be abused for that too) andin that case also deal with those.
You can surely gather them in the omp-offload.cc pass and then call
a function in your new file to handle that.

	Jakub

[PATCH 5/7] openmp: Add C++ support for parsing metadirectives

[Kwok Cheung Yeung]

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

This patch adds metadirective parsing support to the C++ parser. This is 
basically just a straight port of the C code to the C++ front end.

Kwok

[-- Attachment #2: 0005-openmp-Add-C-support-for-parsing-metadirectives.patch --]
[-- Type: text/plain, Size: 15927 bytes --]

From e9bb138d4c3f560e48e408facce2361533685a98 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:58:01 +0000
Subject: [PATCH 5/7] openmp: Add C++ support for parsing metadirectives

This adds support for parsing OpenMP metadirectives in the C++ front end.

2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/cp/
	* parser.c (cp_parser_skip_to_end_of_statement): Handle parentheses.
	(cp_parser_skip_to_end_of_block_or_statement): Likewise.
	(cp_parser_omp_context_selector): Add extra argument.  Allow
	non-constant expressions.
	(cp_parser_omp_context_selector_specification): Add extra argument and
	propagate to cp_parser_omp_context_selector.
	(analyze_metadirective_body): New.
	(cp_parser_omp_metadirective): New.
	(cp_parser_omp_construct): Handle PRAGMA_OMP_METADIRECTIVE.
	(cp_parser_pragma): Handle PRAGMA_OMP_METADIRECTIVE.
---
 gcc/cp/parser.c | 425 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 417 insertions(+), 8 deletions(-)

diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
index 6f273bfe21f..afbfe148949 100644
--- a/gcc/cp/parser.c
+++ b/gcc/cp/parser.c
@@ -3907,6 +3907,17 @@ cp_parser_skip_to_end_of_statement (cp_parser* parser)
 	  ++nesting_depth;
 	  break;
 
+	case CPP_OPEN_PAREN:
+	  /* Track parentheses in case the statement is a standalone 'for'
+	     statement - we want to skip over the semicolons separating the
+	     operands.  */
+	  ++nesting_depth;
+	  break;
+
+	case CPP_CLOSE_PAREN:
+	  --nesting_depth;
+	  break;
+
 	case CPP_KEYWORD:
 	  if (token->keyword != RID__EXPORT
 	      && token->keyword != RID__MODULE
@@ -3996,6 +4007,17 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
 	  nesting_depth++;
 	  break;
 
+	case CPP_OPEN_PAREN:
+	  /* Track parentheses in case the statement is a standalone 'for'
+	     statement - we want to skip over the semicolons separating the
+	     operands.  */
+	  nesting_depth++;
+	  break;
+
+	case CPP_CLOSE_PAREN:
+	  nesting_depth--;
+	  break;
+
 	case CPP_KEYWORD:
 	  if (token->keyword != RID__EXPORT
 	      && token->keyword != RID__MODULE
@@ -44972,7 +44994,8 @@ static const char *const omp_user_selectors[] = {
      score(score-expression)  */
 
 static tree
-cp_parser_omp_context_selector (cp_parser *parser, tree set, bool has_parms_p)
+cp_parser_omp_context_selector (cp_parser *parser, tree set, bool has_parms_p,
+				bool metadirective_p)
 {
   tree ret = NULL_TREE;
   do
@@ -45188,15 +45211,21 @@ cp_parser_omp_context_selector (cp_parser *parser, tree set, bool has_parms_p)
 	      while (1);
 	      break;
 	    case CTX_PROPERTY_EXPR:
-	      t = cp_parser_constant_expression (parser);
+	      /* Allow non-constant expressions in metadirectives.  */
+	      t = metadirective_p
+		  ? cp_parser_expression (parser)
+		  : cp_parser_constant_expression (parser);
 	      if (t != error_mark_node)
 		{
 		  t = fold_non_dependent_expr (t);
-		  if (!value_dependent_expression_p (t)
-		      && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
-			  || !tree_fits_shwi_p (t)))
+		  if (metadirective_p && !INTEGRAL_TYPE_P (TREE_TYPE (t)))
 		    error_at (token->location, "property must be "
-			      "constant integer expression");
+					       "integer expression");
+		  else if (!metadirective_p && !value_dependent_expression_p (t)
+			    && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
+				|| !tree_fits_shwi_p (t)))
+		    error_at (token->location, "property must be constant "
+					       "integer expression");
 		  else
 		    properties = tree_cons (NULL_TREE, t, properties);
 		}
@@ -45260,7 +45289,8 @@ cp_parser_omp_context_selector (cp_parser *parser, tree set, bool has_parms_p)
 
 static tree
 cp_parser_omp_context_selector_specification (cp_parser *parser,
-					      bool has_parms_p)
+					      bool has_parms_p,
+					      bool metadirective_p = false)
 {
   tree ret = NULL_TREE;
   do
@@ -45308,7 +45338,8 @@ cp_parser_omp_context_selector_specification (cp_parser *parser,
 	return error_mark_node;
 
       tree selectors
-	= cp_parser_omp_context_selector (parser, set, has_parms_p);
+	= cp_parser_omp_context_selector (parser, set, has_parms_p,
+					  metadirective_p);
       if (selectors == error_mark_node)
 	{
 	  cp_parser_skip_to_closing_brace (parser);
@@ -45831,6 +45862,378 @@ cp_parser_omp_end_declare_target (cp_parser *parser, cp_token *pragma_tok)
     }
 }
 
+
+/* Helper function for c_parser_omp_metadirective.  */
+
+static void
+analyze_metadirective_body (cp_parser *parser,
+			    vec<cp_token> &tokens,
+			    vec<tree> &labels)
+{
+  int nesting_depth = 0;
+  int bracket_depth = 0;
+  bool in_case = false;
+  bool in_label_decl = false;
+
+  while (1)
+    {
+      cp_token *token = cp_lexer_peek_token (parser->lexer);
+      bool stop = false;
+
+      if (cp_lexer_next_token_is_keyword (parser->lexer, RID_CASE))
+	in_case = true;
+      else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_LABEL))
+	in_label_decl = true;
+
+      switch (token->type)
+	{
+	case CPP_EOF:
+	  break;
+	case CPP_NAME:
+	  if ((!in_case
+	       && cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON))
+	      || in_label_decl)
+	    labels.safe_push (token->u.value);
+	  goto add;
+	case CPP_OPEN_BRACE:
+	  ++nesting_depth;
+	  goto add;
+	case CPP_CLOSE_BRACE:
+	  if (--nesting_depth == 0)
+	    stop = true;
+	  goto add;
+	case CPP_OPEN_PAREN:
+	  ++bracket_depth;
+	  goto add;
+	case CPP_CLOSE_PAREN:
+	  --bracket_depth;
+	  goto add;
+	case CPP_COLON:
+	  in_case = false;
+	  goto add;
+	case CPP_SEMICOLON:
+	  if (nesting_depth == 0 && bracket_depth == 0)
+	    stop = true;
+	  /* Local label declarations are terminated by a semicolon.  */
+	  in_label_decl = false;
+	  goto add;
+	default:
+	add:
+	  tokens.safe_push (*token);
+	  cp_lexer_consume_token (parser->lexer);
+	  if (stop)
+	    break;
+	  continue;
+	}
+      break;
+    }
+}
+
+/* OpenMP 5.0:
+
+  # pragma omp metadirective [clause[, clause]]
+*/
+
+static tree
+cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
+			     char *p_name, omp_clause_mask, tree *,
+			     bool *if_p)
+{
+  tree ret;
+  auto_vec<cp_token> directive_tokens;
+  auto_vec<cp_token> body_tokens;
+  auto_vec<tree> body_labels;
+  auto_vec<const struct c_omp_directive *> directives;
+  auto_vec<tree> ctxs;
+  bool default_seen = false;
+  int directive_token_idx = 0;
+  location_t loc = cp_lexer_peek_token (parser->lexer)->location;
+  tree standalone_body = NULL_TREE;
+  vec<struct omp_metadirective_variant> candidates;
+
+  ret = make_node (OMP_METADIRECTIVE);
+  SET_EXPR_LOCATION (ret, loc);
+  TREE_TYPE (ret) = void_type_node;
+  OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
+  strcat (p_name, " metadirective");
+
+  while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
+    {
+      if (cp_lexer_next_token_is_not (parser->lexer, CPP_NAME)
+	  && cp_lexer_next_token_is_not (parser->lexer, CPP_KEYWORD))
+	{
+	  cp_parser_error (parser, "expected %<when%> or %<default%>");
+	  goto fail;
+	}
+
+      location_t match_loc = cp_lexer_peek_token (parser->lexer)->location;
+      const char *p
+	= IDENTIFIER_POINTER (cp_lexer_peek_token (parser->lexer)->u.value);
+      cp_lexer_consume_token (parser->lexer);
+      bool default_p = strcmp (p, "default") == 0;
+      if (default_p)
+	{
+	  if (default_seen)
+	    {
+	      cp_parser_error (parser, "there can only be one default clause "
+				       "in a metadirective");
+	      goto fail;
+	    }
+	  else
+	    default_seen = true;
+	}
+      if (!strcmp (p, "when") == 0 && !default_p)
+	{
+	  cp_parser_error (parser, "expected %<when%> or %<default%>");
+	  goto fail;
+	}
+
+      matching_parens parens;
+      tree ctx = NULL_TREE;
+      bool skip = false;
+
+      if (!parens.require_open (parser))
+	goto fail;
+
+      if (!default_p)
+	{
+	  ctx = cp_parser_omp_context_selector_specification (parser, false,
+							      true);
+	  if (ctx == error_mark_node)
+	    goto fail;
+	  ctx = omp_check_context_selector (match_loc, ctx);
+	  if (ctx == error_mark_node)
+	    goto fail;
+
+	  /* Remove the selector from further consideration if can be
+	     evaluated as a non-match at this point.  */
+	  skip = (omp_context_selector_matches (ctx, true) == 0);
+
+	  if (cp_lexer_next_token_is_not (parser->lexer, CPP_COLON))
+	    {
+	      cp_parser_error (parser, "expected colon");
+	      goto fail;
+	    }
+	  cp_lexer_consume_token (parser->lexer);
+	}
+
+      /* Read in the directive type and create a dummy pragma token for
+	 it.  */
+      location_t loc = cp_lexer_peek_token (parser->lexer)->location;
+
+      p = NULL;
+      if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_PAREN))
+	p = "nothing";
+      else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
+	{
+	  p = "for";
+	  cp_lexer_consume_token (parser->lexer);
+	}
+      else if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
+	{
+	  cp_token *token = cp_lexer_consume_token (parser->lexer);
+	  p = IDENTIFIER_POINTER (token->u.value);
+	}
+
+      if (p == NULL)
+	{
+	  cp_parser_error (parser, "expected directive name");
+	  goto fail;
+	}
+
+      const struct c_omp_directive *omp_directive
+	= c_omp_categorize_directive (p, NULL, NULL);
+
+      if (omp_directive == NULL)
+	{
+	  cp_parser_error (parser, "unknown directive name");
+	  goto fail;
+	}
+      if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
+	{
+	  cp_parser_error (parser,
+			   "metadirectives cannot be used as directive "
+			   "variants");
+	  goto fail;
+	}
+      if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
+	{
+	  sorry_at (loc, "declarative directive variants are not supported");
+	  goto fail;
+	}
+
+      if (!skip)
+	{
+	  cp_token pragma_token;
+	  pragma_token.type = CPP_PRAGMA;
+	  pragma_token.location = loc;
+	  pragma_token.u.value = build_int_cst (NULL, omp_directive->id);
+
+	  directives.safe_push (omp_directive);
+	  directive_tokens.safe_push (pragma_token);
+	  ctxs.safe_push (ctx);
+	}
+
+      /* Read in tokens for the directive clauses.  */
+      int nesting_depth = 0;
+      while (1)
+	{
+	  cp_token *token = cp_lexer_peek_token (parser->lexer);
+	  switch (token->type)
+	    {
+	    case CPP_EOF:
+	    case CPP_PRAGMA_EOL:
+	      break;
+	    case CPP_OPEN_PAREN:
+	      ++nesting_depth;
+	      goto add;
+	    case CPP_CLOSE_PAREN:
+	      if (nesting_depth-- == 0)
+		break;
+	      goto add;
+	    default:
+	    add:
+	      if (!skip)
+		directive_tokens.safe_push (*token);
+	      cp_lexer_consume_token (parser->lexer);
+	      continue;
+	    }
+	  break;
+	}
+
+      cp_lexer_consume_token (parser->lexer);
+
+      if (!skip)
+	{
+	  cp_token eol_token = {};
+	  eol_token.type = CPP_PRAGMA_EOL;
+	  eol_token.keyword = RID_MAX;
+	  directive_tokens.safe_push (eol_token);
+	}
+    }
+  cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+
+  if (!default_seen)
+    {
+      /* Add a default clause that evaluates to 'omp nothing'.  */
+      const struct c_omp_directive *omp_directive
+	= c_omp_categorize_directive ("nothing", NULL, NULL);
+
+      cp_token pragma_token = {};
+      pragma_token.type = CPP_PRAGMA;
+      pragma_token.keyword = RID_MAX;
+      pragma_token.location = UNKNOWN_LOCATION;
+      pragma_token.u.value = build_int_cst (NULL, PRAGMA_OMP_NOTHING);
+
+      directives.safe_push (omp_directive);
+      directive_tokens.safe_push (pragma_token);
+      ctxs.safe_push (NULL_TREE);
+
+      cp_token eol_token = {};
+      eol_token.type = CPP_PRAGMA_EOL;
+      eol_token.keyword = RID_MAX;
+      directive_tokens.safe_push (eol_token);
+    }
+
+  analyze_metadirective_body (parser, body_tokens, body_labels);
+
+  /* Process each candidate directive.  */
+  unsigned i;
+  tree ctx;
+  cp_lexer *lexer;
+
+  lexer = cp_lexer_alloc ();
+  lexer->debugging_p = parser->lexer->debugging_p;
+  vec_safe_reserve (lexer->buffer,
+		    directive_tokens.length () + body_tokens.length () + 2);
+
+  FOR_EACH_VEC_ELT (ctxs, i, ctx)
+    {
+      lexer->buffer->truncate (0);
+
+      /* Add the directive tokens.  */
+      do
+	lexer->buffer->quick_push (directive_tokens [directive_token_idx++]);
+      while (lexer->buffer->last ().type != CPP_PRAGMA_EOL);
+
+      /* Add the body tokens.  */
+      for (unsigned j = 0; j < body_tokens.length (); j++)
+	lexer->buffer->quick_push (body_tokens[j]);
+
+      /* Make sure nothing tries to read past the end of the tokens.  */
+      cp_token eof_token = {};
+      eof_token.type = CPP_EOF;
+      eof_token.keyword = RID_MAX;
+      lexer->buffer->quick_push (eof_token);
+      lexer->buffer->quick_push (eof_token);
+
+      lexer->next_token = lexer->buffer->address();
+      lexer->last_token = lexer->next_token + lexer->buffer->length () - 1;
+
+      cp_lexer *old_lexer = parser->lexer;
+      parser->lexer = lexer;
+      cp_lexer_set_source_position_from_token (lexer->next_token);
+
+      tree directive = push_stmt_list ();
+      tree directive_stmt = begin_compound_stmt (0);
+
+      /* Declare all labels that occur within the directive body as
+	 local.  */
+      for (unsigned j = 0; j < body_labels.length (); j++)
+	finish_label_decl (body_labels[j]);
+      cp_parser_pragma (parser, pragma_compound, if_p);
+
+      finish_compound_stmt (directive_stmt);
+      directive = pop_stmt_list (directive);
+
+      bool standalone_p
+	= directives[i]->kind == C_OMP_DIR_STANDALONE
+	  || directives[i]->kind == C_OMP_DIR_UTILITY;
+      if (standalone_p)
+	{
+	  /* Parsing standalone directives will not consume the body
+	     tokens, so do that here.  */
+	  if (standalone_body == NULL_TREE)
+	    {
+	      standalone_body = push_stmt_list ();
+	      cp_parser_statement (parser, NULL_TREE, false, if_p);
+	      standalone_body = pop_stmt_list (standalone_body);
+	    }
+	  else
+	    cp_parser_skip_to_end_of_block_or_statement (parser);
+	}
+
+      tree body = standalone_p ? standalone_body : NULL_TREE;
+      tree variant = build_tree_list (ctx, build_tree_list (directive, body));
+      OMP_METADIRECTIVE_CLAUSES (ret)
+	= chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
+
+      /* Check that all valid tokens have been consumed.  */
+      gcc_assert (cp_lexer_next_token_is (parser->lexer, CPP_EOF));
+
+      parser->lexer = old_lexer;
+      cp_lexer_set_source_position_from_token (old_lexer->next_token);
+    }
+
+  /* Try to resolve the metadirective early.  */
+  candidates = omp_resolve_metadirective (ret);
+  if (!candidates.is_empty ())
+    ret = c_omp_expand_metadirective (candidates);
+
+  add_stmt (ret);
+
+  return ret;
+
+fail:
+  /* Skip the metadirective pragma.  */
+  cp_parser_skip_to_pragma_eol (parser, pragma_tok);
+
+  /* Skip the metadirective body.  */
+  cp_parser_skip_to_end_of_block_or_statement (parser);
+  return error_mark_node;
+}
+
+
 /* Helper function of cp_parser_omp_declare_reduction.  Parse the combiner
    expression and optional initializer clause of
    #pragma omp declare reduction.  We store the expression(s) as
@@ -47077,6 +47480,11 @@ cp_parser_omp_construct (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
       stmt = cp_parser_omp_master (parser, pragma_tok, p_name, mask, NULL,
 				   if_p);
       break;
+    case PRAGMA_OMP_METADIRECTIVE:
+      strcpy (p_name, "#pragma omp");
+      stmt = cp_parser_omp_metadirective (parser, pragma_tok, p_name, mask,
+					  NULL, if_p);
+      break;
     case PRAGMA_OMP_PARALLEL:
       strcpy (p_name, "#pragma omp");
       stmt = cp_parser_omp_parallel (parser, pragma_tok, p_name, mask, NULL,
@@ -47727,6 +48135,7 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
     case PRAGMA_OMP_LOOP:
     case PRAGMA_OMP_MASKED:
     case PRAGMA_OMP_MASTER:
+    case PRAGMA_OMP_METADIRECTIVE:
     case PRAGMA_OMP_PARALLEL:
     case PRAGMA_OMP_SCOPE:
     case PRAGMA_OMP_SECTIONS:
-- 
2.25.1

Re: [PATCH 5/7] openmp: Add C++ support for parsing metadirectives

[Jakub Jelinek]

On Fri, Dec 10, 2021 at 05:37:34PM +0000, Kwok Cheung Yeung wrote:
> From e9bb138d4c3f560e48e408facce2361533685a98 Mon Sep 17 00:00:00 2001
> From: Kwok Cheung Yeung <kcy@codesourcery.com>
> Date: Mon, 6 Dec 2021 22:58:01 +0000
> Subject: [PATCH 5/7] openmp: Add C++ support for parsing metadirectives
> 
> This adds support for parsing OpenMP metadirectives in the C++ front end.
> 
> 2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>
> 
> 	gcc/cp/
> 	* parser.c (cp_parser_skip_to_end_of_statement): Handle parentheses.
> 	(cp_parser_skip_to_end_of_block_or_statement): Likewise.
> 	(cp_parser_omp_context_selector): Add extra argument.  Allow
> 	non-constant expressions.
> 	(cp_parser_omp_context_selector_specification): Add extra argument and
> 	propagate to cp_parser_omp_context_selector.
> 	(analyze_metadirective_body): New.
> 	(cp_parser_omp_metadirective): New.
> 	(cp_parser_omp_construct): Handle PRAGMA_OMP_METADIRECTIVE.
> 	(cp_parser_pragma): Handle PRAGMA_OMP_METADIRECTIVE.
> ---
>  gcc/cp/parser.c | 425 +++++++++++++++++++++++++++++++++++++++++++++++-
>  1 file changed, 417 insertions(+), 8 deletions(-)
> 
> diff --git a/gcc/cp/parser.c b/gcc/cp/parser.c
> index 6f273bfe21f..afbfe148949 100644
> --- a/gcc/cp/parser.c
> +++ b/gcc/cp/parser.c
> @@ -3907,6 +3907,17 @@ cp_parser_skip_to_end_of_statement (cp_parser* parser)
>  	  ++nesting_depth;
>  	  break;
>  
> +	case CPP_OPEN_PAREN:
> +	  /* Track parentheses in case the statement is a standalone 'for'
> +	     statement - we want to skip over the semicolons separating the
> +	     operands.  */
> +	  ++nesting_depth;
> +	  break;
> +
> +	case CPP_CLOSE_PAREN:
> +	  --nesting_depth;
> +	  break;
> +
>  	case CPP_KEYWORD:
>  	  if (token->keyword != RID__EXPORT
>  	      && token->keyword != RID__MODULE
> @@ -3996,6 +4007,17 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
>  	  nesting_depth++;
>  	  break;
>  
> +	case CPP_OPEN_PAREN:
> +	  /* Track parentheses in case the statement is a standalone 'for'
> +	     statement - we want to skip over the semicolons separating the
> +	     operands.  */
> +	  nesting_depth++;
> +	  break;
> +
> +	case CPP_CLOSE_PAREN:
> +	  nesting_depth--;
> +	  break;
> +

Like for C FE, I think this is too risky.

>  	    case CTX_PROPERTY_EXPR:
> -	      t = cp_parser_constant_expression (parser);
> +	      /* Allow non-constant expressions in metadirectives.  */
> +	      t = metadirective_p
> +		  ? cp_parser_expression (parser)
> +		  : cp_parser_constant_expression (parser);
>  	      if (t != error_mark_node)
>  		{
>  		  t = fold_non_dependent_expr (t);
> -		  if (!value_dependent_expression_p (t)
> -		      && (!INTEGRAL_TYPE_P (TREE_TYPE (t))
> -			  || !tree_fits_shwi_p (t)))
> +		  if (metadirective_p && !INTEGRAL_TYPE_P (TREE_TYPE (t)))

Like in the other patch, but more importantly, if t is
type_dependent_expression_p, you shouldn't diagnose it, it might be
integral after instantiation.  But it needs to be diagnosed later during
instantiation if it isn't integral then...

> +      cp_token *token = cp_lexer_peek_token (parser->lexer);
> +      bool stop = false;
> +
> +      if (cp_lexer_next_token_is_keyword (parser->lexer, RID_CASE))
> +	in_case = true;
> +      else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_LABEL))
> +	in_label_decl = true;
> +
> +      switch (token->type)
> +	{
> +	case CPP_EOF:
> +	  break;
> +	case CPP_NAME:
> +	  if ((!in_case
> +	       && cp_lexer_nth_token_is (parser->lexer, 2, CPP_COLON))
> +	      || in_label_decl)
> +	    labels.safe_push (token->u.value);

Similar thing as for C, identifier : can appear in various spots even when
it isn't a label, in C++ even in many more cases.  Say
nested struct definition, struct S : T {}; or (that is for both C and C++)
e.g. bitfields struct V { int v : 13; };

> +	  goto add;
> +	case CPP_OPEN_BRACE:
> +	  ++nesting_depth;
> +	  goto add;
> +	case CPP_CLOSE_BRACE:
> +	  if (--nesting_depth == 0)
> +	    stop = true;
> +	  goto add;
> +	case CPP_OPEN_PAREN:
> +	  ++bracket_depth;
> +	  goto add;
> +	case CPP_CLOSE_PAREN:
> +	  --bracket_depth;
> +	  goto add;
> +	case CPP_COLON:
> +	  in_case = false;
> +	  goto add;
> +	case CPP_SEMICOLON:
> +	  if (nesting_depth == 0 && bracket_depth == 0)
> +	    stop = true;
> +	  /* Local label declarations are terminated by a semicolon.  */
> +	  in_label_decl = false;
> +	  goto add;
> +	default:
> +	add:
> +	  tokens.safe_push (*token);
> +	  cp_lexer_consume_token (parser->lexer);
> +	  if (stop)
> +	    break;
> +	  continue;
> +	}
> +      break;
> +    }
> +}
> +
> +/* OpenMP 5.0:
> +
> +  # pragma omp metadirective [clause[, clause]]
> +*/
> +
> +static tree
> +cp_parser_omp_metadirective (cp_parser *parser, cp_token *pragma_tok,
> +			     char *p_name, omp_clause_mask, tree *,
> +			     bool *if_p)
> +{
> +  tree ret;
> +  auto_vec<cp_token> directive_tokens;
> +  auto_vec<cp_token> body_tokens;
> +  auto_vec<tree> body_labels;
> +  auto_vec<const struct c_omp_directive *> directives;
> +  auto_vec<tree> ctxs;
> +  bool default_seen = false;
> +  int directive_token_idx = 0;
> +  location_t loc = cp_lexer_peek_token (parser->lexer)->location;
> +  tree standalone_body = NULL_TREE;
> +  vec<struct omp_metadirective_variant> candidates;
> +
> +  ret = make_node (OMP_METADIRECTIVE);

Better write tree ret = make_node ...
i.e. at least where easily possible declare vars on first use rather than
at the start of function.

Also, same comments I wrote in the C FE patch.

> +  SET_EXPR_LOCATION (ret, loc);
> +  TREE_TYPE (ret) = void_type_node;
> +  OMP_METADIRECTIVE_CLAUSES (ret) = NULL_TREE;
> +  strcat (p_name, " metadirective");
> +
> +  while (cp_lexer_next_token_is_not (parser->lexer, CPP_PRAGMA_EOL))
> +    {
> +      if (cp_lexer_next_token_is_not (parser->lexer, CPP_NAME)
> +	  && cp_lexer_next_token_is_not (parser->lexer, CPP_KEYWORD))
> +	{
> +	  cp_parser_error (parser, "expected %<when%> or %<default%>");
> +	  goto fail;
> +	}
> +
> +      location_t match_loc = cp_lexer_peek_token (parser->lexer)->location;
> +      const char *p
> +	= IDENTIFIER_POINTER (cp_lexer_peek_token (parser->lexer)->u.value);
> +      cp_lexer_consume_token (parser->lexer);
> +      bool default_p = strcmp (p, "default") == 0;
> +      if (default_p)
> +	{
> +	  if (default_seen)
> +	    {
> +	      cp_parser_error (parser, "there can only be one default clause "
> +				       "in a metadirective");
> +	      goto fail;
> +	    }
> +	  else
> +	    default_seen = true;
> +	}
> +      if (!strcmp (p, "when") == 0 && !default_p)
> +	{
> +	  cp_parser_error (parser, "expected %<when%> or %<default%>");
> +	  goto fail;
> +	}
> +
> +      matching_parens parens;
> +      tree ctx = NULL_TREE;
> +      bool skip = false;
> +
> +      if (!parens.require_open (parser))
> +	goto fail;
> +
> +      if (!default_p)
> +	{
> +	  ctx = cp_parser_omp_context_selector_specification (parser, false,
> +							      true);
> +	  if (ctx == error_mark_node)
> +	    goto fail;
> +	  ctx = omp_check_context_selector (match_loc, ctx);
> +	  if (ctx == error_mark_node)
> +	    goto fail;
> +
> +	  /* Remove the selector from further consideration if can be
> +	     evaluated as a non-match at this point.  */
> +	  skip = (omp_context_selector_matches (ctx, true) == 0);
> +
> +	  if (cp_lexer_next_token_is_not (parser->lexer, CPP_COLON))
> +	    {
> +	      cp_parser_error (parser, "expected colon");
> +	      goto fail;
> +	    }
> +	  cp_lexer_consume_token (parser->lexer);
> +	}
> +
> +      /* Read in the directive type and create a dummy pragma token for
> +	 it.  */
> +      location_t loc = cp_lexer_peek_token (parser->lexer)->location;
> +
> +      p = NULL;
> +      if (cp_lexer_next_token_is (parser->lexer, CPP_CLOSE_PAREN))
> +	p = "nothing";
> +      else if (cp_lexer_next_token_is_keyword (parser->lexer, RID_FOR))
> +	{
> +	  p = "for";
> +	  cp_lexer_consume_token (parser->lexer);
> +	}
> +      else if (cp_lexer_next_token_is (parser->lexer, CPP_NAME))
> +	{
> +	  cp_token *token = cp_lexer_consume_token (parser->lexer);
> +	  p = IDENTIFIER_POINTER (token->u.value);
> +	}
> +
> +      if (p == NULL)
> +	{
> +	  cp_parser_error (parser, "expected directive name");
> +	  goto fail;
> +	}
> +
> +      const struct c_omp_directive *omp_directive
> +	= c_omp_categorize_directive (p, NULL, NULL);
> +
> +      if (omp_directive == NULL)
> +	{
> +	  cp_parser_error (parser, "unknown directive name");
> +	  goto fail;
> +	}
> +      if (omp_directive->id == PRAGMA_OMP_METADIRECTIVE)
> +	{
> +	  cp_parser_error (parser,
> +			   "metadirectives cannot be used as directive "
> +			   "variants");
> +	  goto fail;
> +	}
> +      if (omp_directive->kind == C_OMP_DIR_DECLARATIVE)
> +	{
> +	  sorry_at (loc, "declarative directive variants are not supported");
> +	  goto fail;
> +	}
> +
> +      if (!skip)
> +	{
> +	  cp_token pragma_token;
> +	  pragma_token.type = CPP_PRAGMA;
> +	  pragma_token.location = loc;
> +	  pragma_token.u.value = build_int_cst (NULL, omp_directive->id);
> +
> +	  directives.safe_push (omp_directive);
> +	  directive_tokens.safe_push (pragma_token);
> +	  ctxs.safe_push (ctx);
> +	}
> +
> +      /* Read in tokens for the directive clauses.  */
> +      int nesting_depth = 0;
> +      while (1)
> +	{
> +	  cp_token *token = cp_lexer_peek_token (parser->lexer);
> +	  switch (token->type)
> +	    {
> +	    case CPP_EOF:
> +	    case CPP_PRAGMA_EOL:
> +	      break;
> +	    case CPP_OPEN_PAREN:
> +	      ++nesting_depth;
> +	      goto add;
> +	    case CPP_CLOSE_PAREN:
> +	      if (nesting_depth-- == 0)
> +		break;
> +	      goto add;
> +	    default:
> +	    add:
> +	      if (!skip)
> +		directive_tokens.safe_push (*token);
> +	      cp_lexer_consume_token (parser->lexer);
> +	      continue;
> +	    }
> +	  break;
> +	}
> +
> +      cp_lexer_consume_token (parser->lexer);
> +
> +      if (!skip)
> +	{
> +	  cp_token eol_token = {};
> +	  eol_token.type = CPP_PRAGMA_EOL;
> +	  eol_token.keyword = RID_MAX;
> +	  directive_tokens.safe_push (eol_token);
> +	}
> +    }
> +  cp_parser_skip_to_pragma_eol (parser, pragma_tok);
> +
> +  if (!default_seen)
> +    {
> +      /* Add a default clause that evaluates to 'omp nothing'.  */
> +      const struct c_omp_directive *omp_directive
> +	= c_omp_categorize_directive ("nothing", NULL, NULL);
> +
> +      cp_token pragma_token = {};
> +      pragma_token.type = CPP_PRAGMA;
> +      pragma_token.keyword = RID_MAX;
> +      pragma_token.location = UNKNOWN_LOCATION;
> +      pragma_token.u.value = build_int_cst (NULL, PRAGMA_OMP_NOTHING);
> +
> +      directives.safe_push (omp_directive);
> +      directive_tokens.safe_push (pragma_token);
> +      ctxs.safe_push (NULL_TREE);
> +
> +      cp_token eol_token = {};
> +      eol_token.type = CPP_PRAGMA_EOL;
> +      eol_token.keyword = RID_MAX;
> +      directive_tokens.safe_push (eol_token);
> +    }
> +
> +  analyze_metadirective_body (parser, body_tokens, body_labels);
> +
> +  /* Process each candidate directive.  */
> +  unsigned i;
> +  tree ctx;
> +  cp_lexer *lexer;
> +
> +  lexer = cp_lexer_alloc ();
> +  lexer->debugging_p = parser->lexer->debugging_p;
> +  vec_safe_reserve (lexer->buffer,
> +		    directive_tokens.length () + body_tokens.length () + 2);
> +
> +  FOR_EACH_VEC_ELT (ctxs, i, ctx)
> +    {
> +      lexer->buffer->truncate (0);
> +
> +      /* Add the directive tokens.  */
> +      do
> +	lexer->buffer->quick_push (directive_tokens [directive_token_idx++]);
> +      while (lexer->buffer->last ().type != CPP_PRAGMA_EOL);
> +
> +      /* Add the body tokens.  */
> +      for (unsigned j = 0; j < body_tokens.length (); j++)
> +	lexer->buffer->quick_push (body_tokens[j]);
> +
> +      /* Make sure nothing tries to read past the end of the tokens.  */
> +      cp_token eof_token = {};
> +      eof_token.type = CPP_EOF;
> +      eof_token.keyword = RID_MAX;
> +      lexer->buffer->quick_push (eof_token);
> +      lexer->buffer->quick_push (eof_token);
> +
> +      lexer->next_token = lexer->buffer->address();
> +      lexer->last_token = lexer->next_token + lexer->buffer->length () - 1;
> +
> +      cp_lexer *old_lexer = parser->lexer;
> +      parser->lexer = lexer;
> +      cp_lexer_set_source_position_from_token (lexer->next_token);
> +
> +      tree directive = push_stmt_list ();
> +      tree directive_stmt = begin_compound_stmt (0);
> +
> +      /* Declare all labels that occur within the directive body as
> +	 local.  */
> +      for (unsigned j = 0; j < body_labels.length (); j++)
> +	finish_label_decl (body_labels[j]);
> +      cp_parser_pragma (parser, pragma_compound, if_p);
> +
> +      finish_compound_stmt (directive_stmt);
> +      directive = pop_stmt_list (directive);
> +
> +      bool standalone_p
> +	= directives[i]->kind == C_OMP_DIR_STANDALONE
> +	  || directives[i]->kind == C_OMP_DIR_UTILITY;
> +      if (standalone_p)
> +	{
> +	  /* Parsing standalone directives will not consume the body
> +	     tokens, so do that here.  */
> +	  if (standalone_body == NULL_TREE)
> +	    {
> +	      standalone_body = push_stmt_list ();
> +	      cp_parser_statement (parser, NULL_TREE, false, if_p);
> +	      standalone_body = pop_stmt_list (standalone_body);
> +	    }
> +	  else
> +	    cp_parser_skip_to_end_of_block_or_statement (parser);
> +	}
> +
> +      tree body = standalone_p ? standalone_body : NULL_TREE;
> +      tree variant = build_tree_list (ctx, build_tree_list (directive, body));
> +      OMP_METADIRECTIVE_CLAUSES (ret)
> +	= chainon (OMP_METADIRECTIVE_CLAUSES (ret), variant);
> +
> +      /* Check that all valid tokens have been consumed.  */
> +      gcc_assert (cp_lexer_next_token_is (parser->lexer, CPP_EOF));
> +
> +      parser->lexer = old_lexer;
> +      cp_lexer_set_source_position_from_token (old_lexer->next_token);
> +    }
> +
> +  /* Try to resolve the metadirective early.  */
> +  candidates = omp_resolve_metadirective (ret);
> +  if (!candidates.is_empty ())
> +    ret = c_omp_expand_metadirective (candidates);
> +
> +  add_stmt (ret);
> +
> +  return ret;
> +
> +fail:
> +  /* Skip the metadirective pragma.  */
> +  cp_parser_skip_to_pragma_eol (parser, pragma_tok);
> +
> +  /* Skip the metadirective body.  */
> +  cp_parser_skip_to_end_of_block_or_statement (parser);
> +  return error_mark_node;
> +}
> +
> +
>  /* Helper function of cp_parser_omp_declare_reduction.  Parse the combiner
>     expression and optional initializer clause of
>     #pragma omp declare reduction.  We store the expression(s) as
> @@ -47077,6 +47480,11 @@ cp_parser_omp_construct (cp_parser *parser, cp_token *pragma_tok, bool *if_p)
>        stmt = cp_parser_omp_master (parser, pragma_tok, p_name, mask, NULL,
>  				   if_p);
>        break;
> +    case PRAGMA_OMP_METADIRECTIVE:
> +      strcpy (p_name, "#pragma omp");
> +      stmt = cp_parser_omp_metadirective (parser, pragma_tok, p_name, mask,
> +					  NULL, if_p);
> +      break;
>      case PRAGMA_OMP_PARALLEL:
>        strcpy (p_name, "#pragma omp");
>        stmt = cp_parser_omp_parallel (parser, pragma_tok, p_name, mask, NULL,
> @@ -47727,6 +48135,7 @@ cp_parser_pragma (cp_parser *parser, enum pragma_context context, bool *if_p)
>      case PRAGMA_OMP_LOOP:
>      case PRAGMA_OMP_MASKED:
>      case PRAGMA_OMP_MASTER:
> +    case PRAGMA_OMP_METADIRECTIVE:
>      case PRAGMA_OMP_PARALLEL:
>      case PRAGMA_OMP_SCOPE:
>      case PRAGMA_OMP_SECTIONS:
> -- 

I miss handling of OMP_METADIRECTIVE in pt.c and testsuite coverage
of metadirectives in templates (both function templates and class templates
in whose methods metadirectives are used).

And something I forgot to note in the C FE patch, there is the
"The context selector that appears in a when clause must not specify any properties
for the simd selector."
restriction I haven't seen being checked for (and tested in the testsuite).

	Jakub

[PATCH 6/7] openmp, fortran: Add Fortran support for parsing metadirectives

[Kwok Cheung Yeung]

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

This patch implements metadirective parsing in the Fortran frontend.

The code previously used to process context selectors in 'declare 
variant' is refactored so that it can be reused in metadirectives. The 
big case lists in parse_executable are moved into macros, since 
parse_omp_metadirective_body needs to know how to act depending on the 
type of directive variant. The selection of end statements in 
parse_omp_do and parse_omp_structured_block are also delegated to 
gfc_omp_end_stmt.

Labels in directive variant bodies are handled by assigning a unique 
number to each statement body parsed in a metadirective, and adding this 
number as a field to gfc_st_label, such that labels with identical 
numbers but different region ids are considered different.

I have also reverted my previous changes to the TREE_STRING_LENGTH check 
in omp_check_context_selector and omp_context_name_list_prop. This is 
because in the accel compiler, lang_GNU_Fortran returns 0 even when the 
code is in Fortran, resulting in the selector failing to match. Instead, 
I opted to increment the TREE_STRING_LENGTH when it is created in 
gfc_trans_omp_set_selector - this should be safe as it is an internal 
implementation detail not visible to end users.

Kwok

[-- Attachment #2: 0006-openmp-fortran-Add-Fortran-support-for-parsing-metad.patch --]
[-- Type: text/plain, Size: 55661 bytes --]

From eed8a06fca397edd5fb451f08c8b1a6f7d67951a Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Mon, 6 Dec 2021 22:59:36 +0000
Subject: [PATCH 6/7] openmp, fortran: Add Fortran support for parsing
 metadirectives

This adds support for parsing OpenMP metadirectives in the Fortran front end.

2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* omp-general.c (omp_check_context_selector): Revert string length
	check.
	(omp_context_name_list_prop): Likewise.

	gcc/fortran/
	* decl.c (gfc_match_end): Handle COMP_OMP_METADIRECTIVE and
	COMP_OMP_BEGIN_METADIRECTIVE.
	* dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_METADIRECTIVE.
	(show_code_node): Handle EXEC_OMP_METADIRECTIVE.
	* gfortran.h (enum gfc_statement): Add ST_OMP_METADIRECTIVE,
	ST_OMP_BEGIN_METADIRECTIVE and ST_OMP_END_METADIRECTIVE.
	(struct gfc_omp_metadirective_clause): New structure.
	(gfc_get_omp_metadirective_clause): New macro.
	(struct gfc_st_label): Add omp_region field.
	(enum gfc_exec_op): Add EXEC_OMP_METADIRECTIVE.
	(struct gfc_code): Add omp_metadirective_clauses field.
	(gfc_free_omp_metadirective_clauses): New prototype.
	(match_omp_directive): New prototype.
	* io.c (format_asterisk): Initialize omp_region field.
	* match.h (gfc_match_omp_begin_metadirective): New prototype.
	(gfc_match_omp_metadirective): New prototype.
	* openmp.c (gfc_match_omp_eos): Match ')' in context selectors.
	(gfc_free_omp_metadirective_clauses): New.
	(gfc_match_omp_clauses): Remove context_selector argument.  Rely on
	gfc_match_omp_eos to match end of clauses.
	(match_omp): Remove extra argument to gfc_match_omp_clauses.
	(gfc_match_omp_context_selector): Remove extra argument to
	gfc_match_omp_clauses.  Set gfc_matching_omp_context_selector
	before call to gfc_match_omp_clauses and reset after.
	(gfc_match_omp_context_selector_specification): Modify to take a
	gfc_omp_set_selector** argument.
	(gfc_match_omp_declare_variant): Pass set_selectors to
	gfc_match_omp_context_selector_specification.
	(match_omp_metadirective): New.
	(gfc_match_omp_begin_metadirective): New.
	(gfc_match_omp_metadirective): New.
	(resolve_omp_metadirective): New.
	(gfc_resolve_omp_directive): Handle EXEC_OMP_METADIRECTIVE.
	* parse.c (gfc_matching_omp_context_selector): New variable.
	(gfc_in_metadirective_body): New variable.
	(gfc_omp_region_count): New variable.
	(decode_omp_directive): Match 'begin metadirective',
	'end metadirective' and 'metadirective'.
	(match_omp_directive): New.
	(case_omp_structured_block): New.
	(case_omp_do): New.
	(gfc_ascii_statement): Handle metadirective statements.
	(gfc_omp_end_stmt): New.
	(parse_omp_do): Delegate to gfc_omp_end_stmt.
	(parse_omp_structured_block): Delegate to gfc_omp_end_stmt. Handle
	ST_OMP_END_METADIRECTIVE.
	(parse_omp_metadirective_body): New.
	(parse_executable): Delegate to case_omp_structured_block and
	case_omp_do.  Return after one statement if compiling regular
	metadirective.  Handle metadirective statements.
	(gfc_parse_file): Reset gfc_omp_region_count,
	gfc_in_metadirective_body and gfc_matching_omp_context_selector.
	* parse.h (enum gfc_compile_state): Add COMP_OMP_METADIRECTIVE and
	COMP_OMP_BEGIN_METADIRECTIVE.
	(gfc_omp_end_stmt): New prototype.
	(gfc_matching_omp_context_selector): New declaration.
	(gfc_in_metadirective_body): New declaration.
	(gfc_omp_region_count): New declaration.
	* resolve.c (gfc_resolve_code): Handle EXEC_OMP_METADIRECTIVE.
	* st.c (gfc_free_statement): Handle EXEC_OMP_METADIRECTIVE.
	* symbol.c (compare_st_labels): Take omp_region into account.
	(gfc_get_st_labels): Incorporate omp_region into label.
	* trans-decl.c (gfc_get_label_decl): Add omp_region into translated
	label name.
	* trans-openmp.c (gfc_trans_omp_directive): Handle
	EXEC_OMP_METADIRECTIVE.
	(gfc_trans_omp_set_selector): Hoist code from...
	(gfc_trans_omp_declare_variant): ...here.
	(gfc_trans_omp_metadirective): New.
	* trans-stmt.h (gfc_trans_omp_metadirective): New prototype.
	* trans.c (trans_code): Handle EXEC_OMP_METADIRECTIVE.
---
 gcc/fortran/decl.c            |   8 +
 gcc/fortran/dump-parse-tree.c |  20 ++
 gcc/fortran/gfortran.h        |  17 ++
 gcc/fortran/io.c              |   2 +-
 gcc/fortran/match.h           |   2 +
 gcc/fortran/openmp.c          | 222 ++++++++++++--
 gcc/fortran/parse.c           | 532 ++++++++++++++++++++--------------
 gcc/fortran/parse.h           |   8 +-
 gcc/fortran/resolve.c         |  12 +
 gcc/fortran/st.c              |   4 +
 gcc/fortran/symbol.c          |  18 +-
 gcc/fortran/trans-decl.c      |   5 +-
 gcc/fortran/trans-openmp.c    | 190 +++++++-----
 gcc/fortran/trans-stmt.h      |   1 +
 gcc/fortran/trans.c           |   1 +
 gcc/omp-general.c             |   5 +-
 16 files changed, 729 insertions(+), 318 deletions(-)

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 4971638f9b6..d50c3ea2277 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -8323,6 +8323,8 @@ gfc_match_end (gfc_statement *st)
 
     case COMP_CONTAINS:
     case COMP_DERIVED_CONTAINS:
+    case COMP_OMP_METADIRECTIVE:
+    case COMP_OMP_BEGIN_METADIRECTIVE:
       state = gfc_state_stack->previous->state;
       block_name = gfc_state_stack->previous->sym == NULL
 		 ? NULL : gfc_state_stack->previous->sym->name;
@@ -8475,6 +8477,12 @@ gfc_match_end (gfc_statement *st)
       gfc_free_enum_history ();
       break;
 
+    case COMP_OMP_BEGIN_METADIRECTIVE:
+      *st = ST_OMP_END_METADIRECTIVE;
+      target = " metadirective";
+      eos_ok = 0;
+      break;
+
     default:
       gfc_error ("Unexpected END statement at %C");
       goto cleanup;
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 2aa44ff864c..4ec64ad5ea3 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -2015,6 +2015,7 @@ show_omp_node (int level, gfc_code *c)
     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_METADIRECTIVE: name = "METADIRECTIVE"; break;
     case EXEC_OMP_ORDERED: name = "ORDERED"; break;
     case EXEC_OMP_DEPOBJ: name = "DEPOBJ"; break;
     case EXEC_OMP_PARALLEL: name = "PARALLEL"; break;
@@ -2209,6 +2210,24 @@ show_omp_node (int level, gfc_code *c)
 	  d = d->block;
 	}
     }
+  else if (c->op == EXEC_OMP_METADIRECTIVE)
+    {
+      gfc_omp_metadirective_clause *clause = c->ext.omp_metadirective_clauses;
+
+      while (clause)
+	{
+	  code_indent (level + 1, 0);
+	  if (clause->selectors)
+	    fputs ("WHEN ()\n", dumpfile);
+	  else
+	    fputs ("DEFAULT ()\n", dumpfile);
+	  /* TODO: Print selector.  */
+	  show_code (level + 2, clause->code);
+	  if (clause->next)
+	    fputs ("\n", dumpfile);
+	  clause = clause->next;
+	}
+    }
   else
     show_code (level + 1, c->block->next);
   if (c->op == EXEC_OMP_ATOMIC)
@@ -3335,6 +3354,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OMP_MASTER:
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+    case EXEC_OMP_METADIRECTIVE:
     case EXEC_OMP_ORDERED:
     case EXEC_OMP_PARALLEL:
     case EXEC_OMP_PARALLEL_DO:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e5d2dd7971e..5025df1bda2 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -316,6 +316,7 @@ enum gfc_statement
   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_OMP_METADIRECTIVE, ST_OMP_BEGIN_METADIRECTIVE, ST_OMP_END_METADIRECTIVE,
   ST_OMP_ERROR, ST_NONE
 };
 
@@ -1658,6 +1659,17 @@ typedef struct gfc_omp_declare_variant
 gfc_omp_declare_variant;
 #define gfc_get_omp_declare_variant() XCNEW (gfc_omp_declare_variant)
 
+typedef struct gfc_omp_metadirective_clause
+{
+  struct gfc_omp_metadirective_clause *next;
+  locus where; /* Where the metadirective clause occurred.  */
+
+  gfc_omp_set_selector *selectors;
+  enum gfc_statement stmt;
+  struct gfc_code *code;
+
+} gfc_omp_metadirective_clause;
+#define gfc_get_omp_metadirective_clause() XCNEW (gfc_omp_metadirective_clause)
 
 typedef struct gfc_omp_udr
 {
@@ -1706,6 +1718,7 @@ typedef struct gfc_st_label
   locus where;
 
   gfc_namespace *ns;
+  int omp_region;
 }
 gfc_st_label;
 
@@ -2922,6 +2935,7 @@ enum gfc_exec_op
   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_METADIRECTIVE,
   EXEC_OMP_ERROR
 };
 
@@ -2978,6 +2992,7 @@ typedef struct gfc_code
     gfc_omp_clauses *omp_clauses;
     const char *omp_name;
     gfc_omp_namelist *omp_namelist;
+    gfc_omp_metadirective_clause *omp_metadirective_clauses;
     bool omp_bool;
   }
   ext;		/* Points to additional structures required by statement */
@@ -3552,6 +3567,7 @@ void gfc_free_omp_declare_variant_list (gfc_omp_declare_variant *list);
 void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
 void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
 void gfc_free_omp_udr (gfc_omp_udr *);
+void gfc_free_omp_metadirective_clauses (gfc_omp_metadirective_clause *);
 gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
 void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
 void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool);
@@ -3827,6 +3843,7 @@ void debug (gfc_expr *);
 bool gfc_parse_file (void);
 void gfc_global_used (gfc_gsymbol *, locus *);
 gfc_namespace* gfc_build_block_ns (gfc_namespace *);
+gfc_statement match_omp_directive (void);
 
 /* dependency.c */
 int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index fc97df79eca..adb811a423c 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -29,7 +29,7 @@ along with GCC; see the file COPYING3.  If not see
 
 gfc_st_label
 format_asterisk = {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL,
-		   0, {NULL, NULL}, NULL};
+		   0, {NULL, NULL}, NULL, 0};
 
 typedef struct
 {
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index e9368db281d..cf0f711f4ec 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -151,6 +151,7 @@ match gfc_match_oacc_routine (void);
 match gfc_match_omp_eos_error (void);
 match gfc_match_omp_atomic (void);
 match gfc_match_omp_barrier (void);
+match gfc_match_omp_begin_metadirective (void);
 match gfc_match_omp_cancel (void);
 match gfc_match_omp_cancellation_point (void);
 match gfc_match_omp_critical (void);
@@ -174,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_metadirective (void);
 match gfc_match_omp_nothing (void);
 match gfc_match_omp_ordered (void);
 match gfc_match_omp_ordered_depend (void);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 846fd7b5c5a..1a423c8e041 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -31,7 +31,8 @@ along with GCC; see the file COPYING3.  If not see
 #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 '!'.  */
+   whitespace, followed by '\n' or comment '!'.  In the special case where a
+   context selector is being matched, match against ')' instead.  */
 
 static match
 gfc_match_omp_eos (void)
@@ -42,17 +43,25 @@ gfc_match_omp_eos (void)
   old_loc = gfc_current_locus;
   gfc_gobble_whitespace ();
 
-  c = gfc_next_ascii_char ();
-  switch (c)
+  if (gfc_matching_omp_context_selector)
     {
-    case '!':
-      do
-	c = gfc_next_ascii_char ();
-      while (c != '\n');
-      /* Fall through */
+      if (gfc_peek_ascii_char () == ')')
+	return MATCH_YES;
+    }
+  else
+    {
+      c = gfc_next_ascii_char ();
+      switch (c)
+	{
+	case '!':
+	  do
+	    c = gfc_next_ascii_char ();
+	  while (c != '\n');
+	  /* Fall through */
 
-    case '\n':
-      return MATCH_YES;
+	case '\n':
+	  return MATCH_YES;
+	}
     }
 
   gfc_current_locus = old_loc;
@@ -248,6 +257,19 @@ gfc_free_omp_udr (gfc_omp_udr *omp_udr)
     }
 }
 
+/* Free clauses of an !$omp metadirective construct.  */
+
+void
+gfc_free_omp_metadirective_clauses (gfc_omp_metadirective_clause *clause)
+{
+  while (clause)
+    {
+      gfc_omp_metadirective_clause *next_clause = clause->next;
+      gfc_free_omp_set_selector_list (clause->selectors);
+      free (clause);
+      clause = next_clause;
+    }
+}
 
 static gfc_omp_udr *
 gfc_find_omp_udr (gfc_namespace *ns, const char *name, gfc_typespec *ts)
@@ -1434,8 +1456,7 @@ gfc_match_dupl_atomic (bool not_dupl, const char *name)
 static match
 gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		       bool first = true, bool needs_space = true,
-		       bool openacc = false, bool context_selector = false,
-		       bool openmp_target = false)
+		       bool openacc = false, bool openmp_target = false)
 {
   bool error = false;
   gfc_omp_clauses *c = gfc_get_omp_clauses ();
@@ -2982,9 +3003,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
     }
 
 end:
-  if (error
-      || (context_selector && gfc_peek_ascii_char () != ')')
-      || (!context_selector && 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");
@@ -3655,7 +3674,7 @@ static match
 match_omp (gfc_exec_op op, const omp_mask mask)
 {
   gfc_omp_clauses *c;
-  if (gfc_match_omp_clauses (&c, mask, true, true, false, false,
+  if (gfc_match_omp_clauses (&c, mask, true, true, false,
 			     op == EXEC_OMP_TARGET) != MATCH_YES)
     return MATCH_ERROR;
   new_st.op = op;
@@ -4804,14 +4823,17 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
 	      break;
 	    case CTX_PROPERTY_SIMD:
 	      {
+		gfc_matching_omp_context_selector = true;
 		if (gfc_match_omp_clauses (&otp->clauses,
 					   OMP_DECLARE_SIMD_CLAUSES,
-					   true, false, false, true)
+					   true, false, false)
 		    != MATCH_YES)
 		  {
-		  gfc_error ("expected simd clause at %C");
+		    gfc_matching_omp_context_selector = false;
+		    gfc_error ("expected simd clause at %C");
 		    return MATCH_ERROR;
 		  }
+		gfc_matching_omp_context_selector = false;
 		break;
 	      }
 	    default:
@@ -4857,7 +4879,7 @@ gfc_match_omp_context_selector (gfc_omp_set_selector *oss)
      user  */
 
 match
-gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv)
+gfc_match_omp_context_selector_specification (gfc_omp_set_selector **oss_head)
 {
   do
     {
@@ -4897,9 +4919,9 @@ gfc_match_omp_context_selector_specification (gfc_omp_declare_variant *odv)
 	}
 
       gfc_omp_set_selector *oss = gfc_get_omp_set_selector ();
-      oss->next = odv->set_selectors;
+      oss->next = *oss_head;
       oss->trait_set_selector_name = selector_sets[i];
-      odv->set_selectors = oss;
+      *oss_head = oss;
 
       if (gfc_match_omp_context_selector (oss) != MATCH_YES)
 	return MATCH_ERROR;
@@ -5000,7 +5022,8 @@ gfc_match_omp_declare_variant (void)
 	  return MATCH_ERROR;
 	}
 
-      if (gfc_match_omp_context_selector_specification (odv) != MATCH_YES)
+      if (gfc_match_omp_context_selector_specification (&odv->set_selectors)
+	  != MATCH_YES)
 	return MATCH_ERROR;
 
       if (gfc_match (" )") != MATCH_YES)
@@ -5016,6 +5039,145 @@ gfc_match_omp_declare_variant (void)
 }
 
 
+static match
+match_omp_metadirective (bool begin_p)
+{
+  locus old_loc = gfc_current_locus;
+  gfc_omp_metadirective_clause *clause_head;
+  gfc_omp_metadirective_clause **next_clause = &clause_head;
+  bool default_seen = false;
+
+  /* Parse the context selectors.  */
+  for (;;)
+    {
+      bool default_p = false;
+      gfc_omp_set_selector *selectors = NULL;
+
+      if (gfc_match (" default ( ") == MATCH_YES)
+	default_p = true;
+      else if (gfc_match_eos () == MATCH_YES)
+	break;
+      else if (gfc_match (" when ( ") != MATCH_YES)
+	{
+	  gfc_error ("expected 'default' or 'when' at %C");
+	  gfc_current_locus = old_loc;
+	  return MATCH_ERROR;
+	}
+
+      if (default_p && default_seen)
+	{
+	  gfc_error ("there can only be one default clause in a "
+		     "metadirective at %C");
+	  gfc_current_locus = old_loc;
+	  return MATCH_ERROR;
+	}
+
+      if (!default_p)
+	{
+	  if (gfc_match_omp_context_selector_specification (&selectors)
+	      != MATCH_YES)
+	    return MATCH_ERROR;
+
+	  if (gfc_match (" : ") != MATCH_YES)
+	    {
+	      gfc_error ("expected ':' at %C");
+	      gfc_current_locus = old_loc;
+	      return MATCH_ERROR;
+	    }
+
+	  gfc_commit_symbols ();
+	}
+
+      gfc_matching_omp_context_selector = true;
+      gfc_statement directive = match_omp_directive ();
+      gfc_matching_omp_context_selector = false;
+
+      if (gfc_error_flag_test ())
+	{
+	  gfc_current_locus = old_loc;
+	  return MATCH_ERROR;
+	}
+
+      if (gfc_match (" )") != MATCH_YES)
+	{
+	  gfc_error ("Expected ')' at %C");
+	  gfc_current_locus = old_loc;
+	  return MATCH_ERROR;
+	}
+
+      gfc_commit_symbols ();
+
+      if (begin_p && directive != ST_NONE
+	  && gfc_omp_end_stmt (directive) == ST_NONE)
+	{
+	  gfc_error ("variant directive used in OMP BEGIN METADIRECTIVE "
+		     "at %C must have a corresponding end directive");
+	  gfc_current_locus = old_loc;
+	  return MATCH_ERROR;
+	}
+
+      if (default_p)
+	default_seen = true;
+
+      gfc_omp_metadirective_clause *omc = gfc_get_omp_metadirective_clause ();
+      omc->selectors = selectors;
+      omc->stmt = directive;
+      if (directive == ST_NONE)
+	{
+	  /* The directive was a 'nothing' directive.  */
+	  omc->code = gfc_get_code (EXEC_CONTINUE);
+	  omc->code->ext.omp_clauses = NULL;
+	}
+      else
+	{
+	  omc->code = gfc_get_code (new_st.op);
+	  omc->code->ext.omp_clauses = new_st.ext.omp_clauses;
+	  /* Prevent the OpenMP clauses from being freed via NEW_ST.  */
+	  new_st.ext.omp_clauses = NULL;
+	}
+
+      *next_clause = omc;
+      next_clause = &omc->next;
+    }
+
+  if (gfc_match_omp_eos () != MATCH_YES)
+    {
+      gfc_error ("Unexpected junk after OMP METADIRECTIVE at %C");
+      gfc_current_locus = old_loc;
+      return MATCH_ERROR;
+    }
+
+  /* Add a 'default (nothing)' clause if no default is explicitly given.  */
+  if (!default_seen)
+    {
+      gfc_omp_metadirective_clause *omc = gfc_get_omp_metadirective_clause ();
+      omc->stmt = ST_NONE;
+      omc->code = gfc_get_code (EXEC_CONTINUE);
+      omc->code->ext.omp_clauses = NULL;
+      omc->selectors = NULL;
+
+      *next_clause = omc;
+      next_clause = &omc->next;
+    }
+
+  new_st.op = EXEC_OMP_METADIRECTIVE;
+  new_st.ext.omp_metadirective_clauses = clause_head;
+
+  return MATCH_YES;
+}
+
+match
+gfc_match_omp_begin_metadirective (void)
+{
+  return match_omp_metadirective (true);
+}
+
+match
+gfc_match_omp_metadirective (void)
+{
+  return match_omp_metadirective (false);
+}
+
 match
 gfc_match_omp_threadprivate (void)
 {
@@ -8486,6 +8648,19 @@ resolve_omp_do (gfc_code *code)
     }
 }
 
+static void
+resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns)
+{
+  gfc_omp_metadirective_clause *clause = code->ext.omp_metadirective_clauses;
+
+  while (clause)
+    {
+      gfc_code *clause_code = clause->code;
+      gfc_resolve_code (clause_code, ns);
+      clause = clause->next;
+    }
+}
+
 
 static gfc_statement
 omp_code_to_statement (gfc_code *code)
@@ -9113,6 +9288,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
       code->ext.omp_clauses->if_present = false;
       resolve_omp_clauses (code, code->ext.omp_clauses, ns);
       break;
+    case EXEC_OMP_METADIRECTIVE:
+      resolve_omp_metadirective (code, ns);
+      break;
     default:
       break;
     }
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 1f111091b0a..a96c892c608 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -40,6 +40,10 @@ static jmp_buf eof_buf;
 gfc_state_data *gfc_state_stack;
 static bool last_was_use_stmt = false;
 
+bool gfc_matching_omp_context_selector;
+bool gfc_in_metadirective_body;
+int gfc_omp_region_count;
+
 /* TODO: Re-order functions to kill these forward decls.  */
 static void check_statement_label (gfc_statement);
 static void undo_new_statement (void);
@@ -889,6 +893,8 @@ decode_omp_directive (void)
       break;
     case 'b':
       matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
+      matcho ("begin metadirective", gfc_match_omp_begin_metadirective,
+	      ST_OMP_BEGIN_METADIRECTIVE);
       break;
     case 'c':
       matcho ("cancellation% point", gfc_match_omp_cancellation_point,
@@ -936,6 +942,8 @@ decode_omp_directive (void)
       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);
+      matcho ("end metadirective", gfc_match_omp_eos_error,
+	      ST_OMP_END_METADIRECTIVE);
       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);
@@ -1018,6 +1026,8 @@ decode_omp_directive (void)
       matcho ("master taskloop", gfc_match_omp_master_taskloop,
 	      ST_OMP_MASTER_TASKLOOP);
       matcho ("master", gfc_match_omp_master, ST_OMP_MASTER);
+      matcho ("metadirective", gfc_match_omp_metadirective,
+	      ST_OMP_METADIRECTIVE);
       break;
     case 'n':
       matcho ("nothing", gfc_match_omp_nothing, ST_NONE);
@@ -1146,6 +1156,10 @@ decode_omp_directive (void)
 	gfc_error_now ("Unclassifiable OpenMP directive at %C");
     }
 
+  /* If parsing a metadirective, let the caller deal with the cleanup.  */
+  if (gfc_matching_omp_context_selector)
+    return ST_NONE;
+
   reject_statement ();
 
   gfc_error_recovery ();
@@ -1213,6 +1227,12 @@ decode_omp_directive (void)
   return ST_GET_FCN_CHARACTERISTICS;
 }
 
+gfc_statement
+match_omp_directive (void)
+{
+  return decode_omp_directive ();
+}
+
 static gfc_statement
 decode_gcc_attribute (void)
 {
@@ -1734,6 +1754,43 @@ next_statement (void)
   case ST_OMP_DECLARE_VARIANT: \
   case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
 
+/* OpenMP statements that are followed by a structured block.  */
+
+#define case_omp_structured_block case ST_OMP_PARALLEL: \
+  case ST_OMP_PARALLEL_MASKED: case ST_OMP_PARALLEL_MASTER: \
+  case ST_OMP_PARALLEL_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: case ST_OMP_TARGET_PARALLEL: \
+  case ST_OMP_TARGET_TEAMS: case ST_OMP_TEAMS: case ST_OMP_TASK: \
+  case ST_OMP_TASKGROUP: \
+  case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE
+
+/* OpenMP statements that are followed by a do loop.  */
+
+#define case_omp_do case ST_OMP_DISTRIBUTE: \
+  case ST_OMP_DISTRIBUTE_PARALLEL_DO: \
+  case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD: 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_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: \
+  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
+
 /* Block end statements.  Errors associated with interchanging these
    are detected in gfc_match_end().  */
 
@@ -2357,6 +2414,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_BARRIER:
       p = "!$OMP BARRIER";
       break;
+    case ST_OMP_BEGIN_METADIRECTIVE:
+      p = "!$OMP BEGIN METADIRECTIVE";
+      break;
     case ST_OMP_CANCEL:
       p = "!$OMP CANCEL";
       break;
@@ -2450,6 +2510,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_END_MASTER_TASKLOOP_SIMD:
       p = "!$OMP END MASTER TASKLOOP SIMD";
       break;
+    case ST_OMP_END_METADIRECTIVE:
+      p = "!OMP END METADIRECTIVE";
+      break;
     case ST_OMP_END_ORDERED:
       p = "!$OMP END ORDERED";
       break;
@@ -2594,6 +2657,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_MASTER_TASKLOOP_SIMD:
       p = "!$OMP MASTER TASKLOOP SIMD";
       break;
+    case ST_OMP_METADIRECTIVE:
+      p = "!$OMP METADIRECTIVE";
+      break;
     case ST_OMP_ORDERED:
     case ST_OMP_ORDERED_DEPEND:
       p = "!$OMP ORDERED";
@@ -2848,6 +2914,8 @@ accept_statement (gfc_statement st)
       break;
 
     case ST_ENTRY:
+    case ST_OMP_METADIRECTIVE:
+    case ST_OMP_BEGIN_METADIRECTIVE:
     case_executable:
     case_exec_markers:
       add_statement ();
@@ -5124,6 +5192,138 @@ loop:
   accept_statement (st);
 }
 
+/* Get the corresponding ending statement type for the OpenMP directive
+   OMP_ST.  If it does not have one, return ST_NONE.  */
+
+gfc_statement
+gfc_omp_end_stmt (gfc_statement omp_st,
+		  bool omp_do_p, bool omp_structured_p)
+{
+  if (omp_do_p)
+    {
+      switch (omp_st)
+	{
+	case ST_OMP_DISTRIBUTE: return ST_OMP_END_DISTRIBUTE;
+	case ST_OMP_DISTRIBUTE_PARALLEL_DO:
+	  return ST_OMP_END_DISTRIBUTE_PARALLEL_DO;
+	case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
+	  return ST_OMP_END_DISTRIBUTE_PARALLEL_DO_SIMD;
+	case ST_OMP_DISTRIBUTE_SIMD:
+	  return ST_OMP_END_DISTRIBUTE_SIMD;
+	case ST_OMP_DO: return ST_OMP_END_DO;
+	case ST_OMP_DO_SIMD: return ST_OMP_END_DO_SIMD;
+	case ST_OMP_LOOP: return ST_OMP_END_LOOP;
+	case ST_OMP_PARALLEL_DO: return ST_OMP_END_PARALLEL_DO;
+	case ST_OMP_PARALLEL_DO_SIMD:
+	  return ST_OMP_END_PARALLEL_DO_SIMD;
+	case ST_OMP_PARALLEL_LOOP:
+	  return ST_OMP_END_PARALLEL_LOOP;
+	case ST_OMP_SIMD: return ST_OMP_END_SIMD;
+	case ST_OMP_TARGET_PARALLEL_DO:
+	  return ST_OMP_END_TARGET_PARALLEL_DO;
+	case ST_OMP_TARGET_PARALLEL_DO_SIMD:
+	  return ST_OMP_END_TARGET_PARALLEL_DO_SIMD;
+	case ST_OMP_TARGET_PARALLEL_LOOP:
+	  return ST_OMP_END_TARGET_PARALLEL_LOOP;
+	case ST_OMP_TARGET_SIMD: return ST_OMP_END_TARGET_SIMD;
+	case ST_OMP_TARGET_TEAMS_DISTRIBUTE:
+	  return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE;
+	case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO:
+	  return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO;
+	case ST_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+	  return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
+	case ST_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD:
+	  return ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD;
+	case ST_OMP_TARGET_TEAMS_LOOP:
+	  return ST_OMP_END_TARGET_TEAMS_LOOP;
+	case ST_OMP_TASKLOOP: return ST_OMP_END_TASKLOOP;
+	case ST_OMP_TASKLOOP_SIMD: return ST_OMP_END_TASKLOOP_SIMD;
+	case ST_OMP_MASKED_TASKLOOP: return ST_OMP_END_MASKED_TASKLOOP;
+	case ST_OMP_MASKED_TASKLOOP_SIMD:
+	  return ST_OMP_END_MASKED_TASKLOOP_SIMD;
+	case ST_OMP_MASTER_TASKLOOP: return ST_OMP_END_MASTER_TASKLOOP;
+	case ST_OMP_MASTER_TASKLOOP_SIMD:
+	  return ST_OMP_END_MASTER_TASKLOOP_SIMD;
+	case ST_OMP_PARALLEL_MASKED_TASKLOOP:
+	  return ST_OMP_END_PARALLEL_MASKED_TASKLOOP;
+	case ST_OMP_PARALLEL_MASKED_TASKLOOP_SIMD:
+	  return ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD;
+	case ST_OMP_PARALLEL_MASTER_TASKLOOP:
+	  return ST_OMP_END_PARALLEL_MASTER_TASKLOOP;
+	case ST_OMP_PARALLEL_MASTER_TASKLOOP_SIMD:
+	  return ST_OMP_END_PARALLEL_MASTER_TASKLOOP_SIMD;
+	case ST_OMP_TEAMS_DISTRIBUTE:
+	  return ST_OMP_END_TEAMS_DISTRIBUTE;
+	case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO:
+	  return ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO;
+	case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD:
+	  return ST_OMP_END_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD;
+	case ST_OMP_TEAMS_DISTRIBUTE_SIMD:
+	  return ST_OMP_END_TEAMS_DISTRIBUTE_SIMD;
+	case ST_OMP_TEAMS_LOOP:
+	  return ST_OMP_END_TEAMS_LOOP;
+	default:
+	  break;
+	}
+    }
+
+  if (omp_structured_p)
+    {
+      switch (omp_st)
+	{
+	case ST_OMP_PARALLEL:
+	  return ST_OMP_END_PARALLEL;
+	case ST_OMP_PARALLEL_MASKED:
+	  return ST_OMP_END_PARALLEL_MASKED;
+	case ST_OMP_PARALLEL_MASTER:
+	  return ST_OMP_END_PARALLEL_MASTER;
+	case ST_OMP_PARALLEL_SECTIONS:
+	  return ST_OMP_END_PARALLEL_SECTIONS;
+	case ST_OMP_SCOPE:
+	  return ST_OMP_END_SCOPE;
+	case ST_OMP_SECTIONS:
+	  return ST_OMP_END_SECTIONS;
+	case ST_OMP_ORDERED:
+	  return ST_OMP_END_ORDERED;
+	case ST_OMP_CRITICAL:
+	  return ST_OMP_END_CRITICAL;
+	case ST_OMP_MASKED:
+	  return ST_OMP_END_MASKED;
+	case ST_OMP_MASTER:
+	  return ST_OMP_END_MASTER;
+	case ST_OMP_SINGLE:
+	  return ST_OMP_END_SINGLE;
+	case ST_OMP_TARGET:
+	  return ST_OMP_END_TARGET;
+	case ST_OMP_TARGET_DATA:
+	  return ST_OMP_END_TARGET_DATA;
+	case ST_OMP_TARGET_PARALLEL:
+	  return ST_OMP_END_TARGET_PARALLEL;
+	case ST_OMP_TARGET_TEAMS:
+	  return ST_OMP_END_TARGET_TEAMS;
+	case ST_OMP_TASK:
+	  return ST_OMP_END_TASK;
+	case ST_OMP_TASKGROUP:
+	  return ST_OMP_END_TASKGROUP;
+	case ST_OMP_TEAMS:
+	  return ST_OMP_END_TEAMS;
+	case ST_OMP_TEAMS_DISTRIBUTE:
+	  return ST_OMP_END_TEAMS_DISTRIBUTE;
+	case ST_OMP_DISTRIBUTE:
+	  return ST_OMP_END_DISTRIBUTE;
+	case ST_OMP_WORKSHARE:
+	  return ST_OMP_END_WORKSHARE;
+	case ST_OMP_PARALLEL_WORKSHARE:
+	  return ST_OMP_END_PARALLEL_WORKSHARE;
+	case ST_OMP_BEGIN_METADIRECTIVE:
+	  return ST_OMP_END_METADIRECTIVE;
+	default:
+	  break;
+	}
+    }
+
+  return ST_NONE;
+}
 
 /* Parse the statements of OpenMP do/parallel do.  */
 
@@ -5174,94 +5374,16 @@ parse_omp_do (gfc_statement omp_st)
   pop_state ();
 
   st = next_statement ();
-  gfc_statement omp_end_st = ST_OMP_END_DO;
-  switch (omp_st)
-    {
-    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_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;
-      break;
-    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;
-      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_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_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;
-    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;
-    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_TEAMS_LOOP:
-      omp_end_st = ST_OMP_END_TEAMS_LOOP;
-      break;
-    default: gcc_unreachable ();
-    }
+  gfc_statement omp_end_st = gfc_omp_end_stmt (omp_st, true, false);
+  if (omp_st == ST_NONE)
+    gcc_unreachable ();
+
+  /* If handling a metadirective variant, treat 'omp end metadirective'
+     as the expected end statement for the current construct.  */
+  if (st == ST_OMP_END_METADIRECTIVE
+      && gfc_state_stack->state == COMP_OMP_BEGIN_METADIRECTIVE)
+    st = omp_end_st;
+
   if (st == omp_end_st)
     {
       if (new_st.op == EXEC_OMP_END_NOWAIT)
@@ -5496,77 +5618,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
   np->op = cp->op;
   np->block = NULL;
 
-  switch (omp_st)
-    {
-    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;
-    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;
-    case ST_OMP_ORDERED:
-      omp_end_st = ST_OMP_END_ORDERED;
-      break;
-    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;
-    case ST_OMP_SINGLE:
-      omp_end_st = ST_OMP_END_SINGLE;
-      break;
-    case ST_OMP_TARGET:
-      omp_end_st = ST_OMP_END_TARGET;
-      break;
-    case ST_OMP_TARGET_DATA:
-      omp_end_st = ST_OMP_END_TARGET_DATA;
-      break;
-    case ST_OMP_TARGET_PARALLEL:
-      omp_end_st = ST_OMP_END_TARGET_PARALLEL;
-      break;
-    case ST_OMP_TARGET_TEAMS:
-      omp_end_st = ST_OMP_END_TARGET_TEAMS;
-      break;
-    case ST_OMP_TASK:
-      omp_end_st = ST_OMP_END_TASK;
-      break;
-    case ST_OMP_TASKGROUP:
-      omp_end_st = ST_OMP_END_TASKGROUP;
-      break;
-    case ST_OMP_TEAMS:
-      omp_end_st = ST_OMP_END_TEAMS;
-      break;
-    case ST_OMP_TEAMS_DISTRIBUTE:
-      omp_end_st = ST_OMP_END_TEAMS_DISTRIBUTE;
-      break;
-    case ST_OMP_DISTRIBUTE:
-      omp_end_st = ST_OMP_END_DISTRIBUTE;
-      break;
-    case ST_OMP_WORKSHARE:
-      omp_end_st = ST_OMP_END_WORKSHARE;
-      break;
-    case ST_OMP_PARALLEL_WORKSHARE:
-      omp_end_st = ST_OMP_END_PARALLEL_WORKSHARE;
-      break;
-    default:
-      gcc_unreachable ();
-    }
+  omp_end_st = gfc_omp_end_stmt (omp_st, false, true);
+  if (omp_st == ST_NONE)
+    gcc_unreachable ();
 
   bool block_construct = false;
   gfc_namespace *my_ns = NULL;
@@ -5665,6 +5719,14 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 	}
       else
 	st = parse_executable (st);
+
+      /* If handling a metadirective variant, treat 'omp end metadirective'
+	 as the expected end statement for the current construct.  */
+      if (st == ST_OMP_END_METADIRECTIVE
+	  && gfc_state_stack->previous != NULL
+	  && gfc_state_stack->previous->state == COMP_OMP_BEGIN_METADIRECTIVE)
+	st = omp_end_st;
+
       if (st == ST_NONE)
 	unexpected_eof ();
       else if (st == ST_OMP_SECTION
@@ -5734,6 +5796,70 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
   return st;
 }
 
+static gfc_statement
+parse_omp_metadirective_body (gfc_statement omp_st)
+{
+  gfc_omp_metadirective_clause *clause = new_st.ext.omp_metadirective_clauses;
+  locus body_locus = gfc_current_locus;
+
+  accept_statement (omp_st);
+
+  gfc_statement next_st = ST_NONE;
+
+  while (clause)
+    {
+      gfc_current_locus = body_locus;
+      gfc_state_data s;
+      bool workshare_p = clause->stmt == ST_OMP_WORKSHARE
+			 || clause->stmt == ST_OMP_PARALLEL_WORKSHARE;
+      enum gfc_compile_state new_state =
+	  (omp_st == ST_OMP_METADIRECTIVE)
+	    ? COMP_OMP_METADIRECTIVE : COMP_OMP_BEGIN_METADIRECTIVE;
+
+      new_st = *clause->code;
+      push_state (&s, new_state, NULL);
+
+      gfc_statement st;
+      bool old_in_metadirective_body = gfc_in_metadirective_body;
+      gfc_in_metadirective_body = true;
+
+      gfc_omp_region_count++;
+      switch (clause->stmt)
+	{
+	case_omp_structured_block:
+	  st = parse_omp_structured_block (clause->stmt, workshare_p);
+	  break;
+	case_omp_do:
+	  st = parse_omp_do (clause->stmt);
+	  /* TODO: Does st == ST_IMPLIED_ENDDO need special handling?  */
+	  break;
+	default:
+	  accept_statement (clause->stmt);
+	  st = parse_executable (next_statement ());
+	  break;
+	}
+
+      gfc_in_metadirective_body = old_in_metadirective_body;
+
+      *clause->code = *gfc_state_stack->head;
+      pop_state ();
+
+      gfc_commit_symbols ();
+      gfc_warning_check ();
+      if (clause->next)
+	gfc_clear_new_st ();
+
+      /* Sanity-check that each clause finishes parsing at the same place.  */
+      if (next_st == ST_NONE)
+	next_st = st;
+      else
+	gcc_assert (st == next_st);
+
+      clause = clause->next;
+    }
+
+  return next_st;
+}
 
 /* Accept a series of executable statements.  We return the first
    statement that doesn't fit to the caller.  Any block statements are
@@ -5744,12 +5870,19 @@ static gfc_statement
 parse_executable (gfc_statement st)
 {
   int close_flag;
+  bool one_stmt_p = false;
 
   if (st == ST_NONE)
     st = next_statement ();
 
   for (;;)
     {
+      /* Only parse one statement for the form of metadirective without
+	 an explicit begin..end.  */
+      if (gfc_state_stack->state == COMP_OMP_METADIRECTIVE && one_stmt_p)
+	return st;
+      one_stmt_p = true;
+
       close_flag = check_do_closure ();
       if (close_flag)
 	switch (st)
@@ -5854,67 +5987,13 @@ parse_executable (gfc_statement st)
 	  parse_oacc_structured_block (st);
 	  break;
 
-	case ST_OMP_PARALLEL:
-	case ST_OMP_PARALLEL_MASKED:
-	case ST_OMP_PARALLEL_MASTER:
-	case ST_OMP_PARALLEL_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:
-	case ST_OMP_TARGET_PARALLEL:
-	case ST_OMP_TARGET_TEAMS:
-	case ST_OMP_TEAMS:
-	case ST_OMP_TASK:
-	case ST_OMP_TASKGROUP:
-	  st = parse_omp_structured_block (st, false);
-	  continue;
-
-	case ST_OMP_WORKSHARE:
-	case ST_OMP_PARALLEL_WORKSHARE:
-	  st = parse_omp_structured_block (st, true);
+	case_omp_structured_block:
+	  st = parse_omp_structured_block (st,
+					   st == ST_OMP_WORKSHARE
+					   || st == ST_OMP_PARALLEL_WORKSHARE);
 	  continue;
 
-	case ST_OMP_DISTRIBUTE:
-	case ST_OMP_DISTRIBUTE_PARALLEL_DO:
-	case ST_OMP_DISTRIBUTE_PARALLEL_DO_SIMD:
-	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_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:
-	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:
+	case_omp_do:
 	  st = parse_omp_do (st);
 	  if (st == ST_IMPLIED_ENDDO)
 	    return st;
@@ -5928,6 +6007,19 @@ parse_executable (gfc_statement st)
 	  st = parse_omp_oacc_atomic (true);
 	  continue;
 
+	case ST_OMP_METADIRECTIVE:
+	case ST_OMP_BEGIN_METADIRECTIVE:
+	  st = parse_omp_metadirective_body (st);
+	  continue;
+
+	case ST_OMP_END_METADIRECTIVE:
+	  if (gfc_state_stack->state == COMP_OMP_BEGIN_METADIRECTIVE)
+	    {
+	      st = next_statement ();
+	      return st;
+	    }
+	  /* FALLTHRU */
+
 	default:
 	  return st;
 	}
@@ -6700,6 +6792,10 @@ gfc_parse_file (void)
 
   gfc_statement_label = NULL;
 
+  gfc_omp_region_count = 0;
+  gfc_in_metadirective_body = false;
+  gfc_matching_omp_context_selector = false;
+
   if (setjmp (eof_buf))
     return false;	/* Come here on unexpected EOF */
 
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 66b275de89b..43bdd91aa14 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -31,7 +31,8 @@ enum gfc_compile_state
   COMP_STRUCTURE, COMP_UNION, COMP_MAP,
   COMP_DO, COMP_SELECT, COMP_FORALL, COMP_WHERE, COMP_CONTAINS, COMP_ENUM,
   COMP_SELECT_TYPE, COMP_SELECT_RANK, COMP_OMP_STRUCTURED_BLOCK, COMP_CRITICAL,
-  COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK
+  COMP_DO_CONCURRENT, COMP_OMP_STRICTLY_STRUCTURED_BLOCK,
+  COMP_OMP_METADIRECTIVE, COMP_OMP_BEGIN_METADIRECTIVE
 };
 
 /* Stack element for the current compilation state.  These structures
@@ -67,10 +68,15 @@ int gfc_check_do_variable (gfc_symtree *);
 bool gfc_find_state (gfc_compile_state);
 gfc_state_data *gfc_enclosing_unit (gfc_compile_state *);
 const char *gfc_ascii_statement (gfc_statement);
+gfc_statement gfc_omp_end_stmt (gfc_statement, bool = true, bool = true);
 match gfc_match_enum (void);
 match gfc_match_enumerator_def (void);
 void gfc_free_enum_history (void);
 extern bool gfc_matching_function;
+extern bool gfc_matching_omp_context_selector;
+extern bool gfc_in_metadirective_body;
+extern int gfc_omp_region_count;
+
 match gfc_match_prefix (gfc_typespec *);
 bool is_oacc (gfc_state_data *);
 #endif  /* GFC_PARSE_H  */
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 0ed31970f8b..1a07aef6771 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11834,6 +11834,17 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
 	  gfc_resolve_forall (code, ns, forall_save);
 	  forall_flag = 2;
 	}
+      else if (code->op == EXEC_OMP_METADIRECTIVE)
+	{
+	  gfc_omp_metadirective_clause *clause
+	    = code->ext.omp_metadirective_clauses;
+
+	  while (clause)
+	    {
+	      gfc_resolve_code (clause->code, ns);
+	      clause = clause->next;
+	    }
+	}
       else if (code->block)
 	{
 	  omp_workshare_save = -1;
@@ -12322,6 +12333,7 @@ start:
 	case EXEC_OMP_MASKED:
 	case EXEC_OMP_MASKED_TASKLOOP:
 	case EXEC_OMP_MASKED_TASKLOOP_SIMD:
+	case EXEC_OMP_METADIRECTIVE:
 	case EXEC_OMP_ORDERED:
 	case EXEC_OMP_SCAN:
 	case EXEC_OMP_SCOPE:
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 6bf730c9062..b15a0885e2e 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -296,6 +296,10 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OMP_TASKYIELD:
       break;
 
+    case EXEC_OMP_METADIRECTIVE:
+      gfc_free_omp_metadirective_clauses (p->ext.omp_metadirective_clauses);
+      break;
+
     default:
       gfc_internal_error ("gfc_free_statement(): Bad statement");
     }
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ebd99846610..8a56ee31b33 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2624,10 +2624,13 @@ free_components (gfc_component *p)
 static int
 compare_st_labels (void *a1, void *b1)
 {
-  int a = ((gfc_st_label *) a1)->value;
-  int b = ((gfc_st_label *) b1)->value;
+  gfc_st_label *a = (gfc_st_label *) a1;
+  gfc_st_label *b = (gfc_st_label *) b1;
 
-  return (b - a);
+  int a_value = a->value + 10000 * a->omp_region;
+  int b_value = b->value + 10000 * b->omp_region;
+
+  return (b_value - a_value);
 }
 
 
@@ -2677,6 +2680,7 @@ gfc_get_st_label (int labelno)
 {
   gfc_st_label *lp;
   gfc_namespace *ns;
+  int omp_region = gfc_in_metadirective_body ? gfc_omp_region_count : 0;
 
   if (gfc_current_state () == COMP_DERIVED)
     ns = gfc_current_block ()->f2k_derived;
@@ -2693,10 +2697,13 @@ gfc_get_st_label (int labelno)
   lp = ns->st_labels;
   while (lp)
     {
-      if (lp->value == labelno)
+      int a = lp->value + 10000 * lp->omp_region;
+      int b = labelno + 10000 * omp_region;
+
+      if (a == b)
 	return lp;
 
-      if (lp->value < labelno)
+      if (a < b)
 	lp = lp->left;
       else
 	lp = lp->right;
@@ -2708,6 +2715,7 @@ gfc_get_st_label (int labelno)
   lp->defined = ST_LABEL_UNKNOWN;
   lp->referenced = ST_LABEL_UNKNOWN;
   lp->ns = ns;
+  lp->omp_region = omp_region;
 
   gfc_insert_bbt (&ns->st_labels, lp, compare_st_labels);
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cb7f684d52c..69ea7f02871 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -326,7 +326,10 @@ gfc_get_label_decl (gfc_st_label * lp)
       gcc_assert (lp != NULL && lp->value <= MAX_LABEL_VALUE);
 
       /* Build a mangled name for the label.  */
-      sprintf (label_name, "__label_%.6d", lp->value);
+      if (lp->omp_region)
+	sprintf (label_name, "__label_%d_%.6d", lp->omp_region, lp->value);
+      else
+	sprintf (label_name, "__label_%.6d", lp->value);
 
       /* Build the LABEL_DECL node.  */
       label_decl = gfc_build_label_decl (get_identifier (label_name));
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d8229a5ac30..3be453a513a 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -7207,6 +7207,8 @@ gfc_trans_omp_directive (gfc_code *code)
     case EXEC_OMP_MASTER_TASKLOOP:
     case EXEC_OMP_MASTER_TASKLOOP_SIMD:
       return gfc_trans_omp_master_masked_taskloop (code, code->op);
+    case EXEC_OMP_METADIRECTIVE:
+      return gfc_trans_omp_metadirective (code);
     case EXEC_OMP_ORDERED:
       return gfc_trans_omp_ordered (code);
     case EXEC_OMP_PARALLEL:
@@ -7298,6 +7300,87 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
     }
 }
 
+static tree
+gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
+{
+  tree set_selectors = NULL_TREE;
+  gfc_omp_set_selector *oss;
+
+  for (oss = gfc_selectors; oss; oss = oss->next)
+    {
+      tree selectors = NULL_TREE;
+      gfc_omp_selector *os;
+      for (os = oss->trait_selectors; os; os = os->next)
+	{
+	  tree properties = NULL_TREE;
+	  gfc_omp_trait_property *otp;
+
+	  for (otp = os->properties; otp; otp = otp->next)
+	    {
+	      switch (otp->property_kind)
+		{
+		case CTX_PROPERTY_USER:
+		case CTX_PROPERTY_EXPR:
+		  {
+		    gfc_se se;
+		    gfc_init_se (&se, NULL);
+		    gfc_conv_expr (&se, otp->expr);
+		    properties = tree_cons (NULL_TREE, se.expr,
+					    properties);
+		  }
+		  break;
+		case CTX_PROPERTY_ID:
+		  properties = tree_cons (get_identifier (otp->name),
+					  NULL_TREE, properties);
+		  break;
+		case CTX_PROPERTY_NAME_LIST:
+		  {
+		    tree prop = NULL_TREE, value = NULL_TREE;
+		    if (otp->is_name)
+		      prop = get_identifier (otp->name);
+		    else
+		      {
+			value = gfc_conv_constant_to_tree (otp->expr);
+
+			/* The string length is expected to include the null
+			   terminator in context selectors.  This is safe as
+			   build_string always null-terminates strings.  */
+			++TREE_STRING_LENGTH (value);
+		      }
+
+		    properties = tree_cons (prop, value, properties);
+		  }
+		  break;
+		case CTX_PROPERTY_SIMD:
+		  properties = gfc_trans_omp_clauses (NULL, otp->clauses,
+						      where, true);
+		  break;
+		default:
+		  gcc_unreachable ();
+		}
+	    }
+
+	  if (os->score)
+	    {
+	      gfc_se se;
+	      gfc_init_se (&se, NULL);
+	      gfc_conv_expr (&se, os->score);
+	      properties = tree_cons (get_identifier (" score"),
+				      se.expr, properties);
+	    }
+
+	  selectors = tree_cons (get_identifier (os->trait_selector_name),
+				 properties, selectors);
+	}
+
+      set_selectors
+	= tree_cons (get_identifier (oss->trait_set_selector_name),
+		     selectors, set_selectors);
+    }
+
+  return set_selectors;
+}
+
 void
 gfc_trans_omp_declare_variant (gfc_namespace *ns)
 {
@@ -7373,73 +7456,8 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
 	      && strcmp (odv->base_proc_symtree->name, ns->proc_name->name)))
 	continue;
 
-      tree set_selectors = NULL_TREE;
-      gfc_omp_set_selector *oss;
-
-      for (oss = odv->set_selectors; oss; oss = oss->next)
-	{
-	  tree selectors = NULL_TREE;
-	  gfc_omp_selector *os;
-	  for (os = oss->trait_selectors; os; os = os->next)
-	    {
-	      tree properties = NULL_TREE;
-	      gfc_omp_trait_property *otp;
-
-	      for (otp = os->properties; otp; otp = otp->next)
-		{
-		  switch (otp->property_kind)
-		    {
-		    case CTX_PROPERTY_USER:
-		    case CTX_PROPERTY_EXPR:
-		      {
-			gfc_se se;
-			gfc_init_se (&se, NULL);
-			gfc_conv_expr (&se, otp->expr);
-			properties = tree_cons (NULL_TREE, se.expr,
-						properties);
-		      }
-		      break;
-		    case CTX_PROPERTY_ID:
-		      properties = tree_cons (get_identifier (otp->name),
-					      NULL_TREE, properties);
-		      break;
-		    case CTX_PROPERTY_NAME_LIST:
-		      {
-			tree prop = NULL_TREE, value = NULL_TREE;
-			if (otp->is_name)
-			  prop = get_identifier (otp->name);
-			else
-			  value = gfc_conv_constant_to_tree (otp->expr);
-
-			properties = tree_cons (prop, value, properties);
-		      }
-		      break;
-		    case CTX_PROPERTY_SIMD:
-		      properties = gfc_trans_omp_clauses (NULL, otp->clauses,
-							  odv->where, true);
-		      break;
-		    default:
-		      gcc_unreachable ();
-		    }
-		}
-
-	      if (os->score)
-		{
-		  gfc_se se;
-		  gfc_init_se (&se, NULL);
-		  gfc_conv_expr (&se, os->score);
-		  properties = tree_cons (get_identifier (" score"),
-					  se.expr, properties);
-		}
-
-	      selectors = tree_cons (get_identifier (os->trait_selector_name),
-				     properties, selectors);
-	    }
-
-	  set_selectors
-	    = tree_cons (get_identifier (oss->trait_set_selector_name),
-			 selectors, set_selectors);
-	}
+      tree set_selectors = gfc_trans_omp_set_selector (odv->set_selectors,
+						       odv->where);
 
       const char *variant_proc_name = odv->variant_proc_symtree->name;
       gfc_symbol *variant_proc_sym = odv->variant_proc_symtree->n.sym;
@@ -7501,3 +7519,41 @@ gfc_trans_omp_declare_variant (gfc_namespace *ns)
 	}
     }
 }
+
+tree
+gfc_trans_omp_metadirective (gfc_code *code)
+{
+  gfc_omp_metadirective_clause *clause = code->ext.omp_metadirective_clauses;
+
+  tree metadirective_tree = make_node (OMP_METADIRECTIVE);
+  SET_EXPR_LOCATION (metadirective_tree, gfc_get_location (&code->loc));
+  TREE_TYPE (metadirective_tree) = void_type_node;
+  OMP_METADIRECTIVE_CLAUSES (metadirective_tree) = NULL_TREE;
+
+  tree tree_body = NULL_TREE;
+
+  while (clause)
+    {
+      tree selectors = gfc_trans_omp_set_selector (clause->selectors,
+						   clause->where);
+      gfc_code *next_code = clause->code->next;
+      if (next_code && tree_body == NULL_TREE)
+	tree_body = gfc_trans_code (next_code);
+
+      if (next_code)
+	clause->code->next = NULL;
+      tree directive = gfc_trans_code (clause->code);
+      if (next_code)
+	clause->code->next = next_code;
+
+      tree body = next_code ? tree_body : NULL_TREE;
+      tree variant = build_tree_list (selectors, build_tree_list (directive, body));
+      OMP_METADIRECTIVE_CLAUSES (metadirective_tree)
+	= chainon (OMP_METADIRECTIVE_CLAUSES (metadirective_tree), variant);
+      clause = clause->next;
+    }
+
+  /* TODO: Resolve the metadirective here if possible.  */
+
+  return metadirective_tree;
+}
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index e824caf4d08..08355e582c8 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -71,6 +71,7 @@ tree gfc_trans_deallocate (gfc_code *);
 tree gfc_trans_omp_directive (gfc_code *);
 void gfc_trans_omp_declare_simd (gfc_namespace *);
 void gfc_trans_omp_declare_variant (gfc_namespace *);
+tree gfc_trans_omp_metadirective (gfc_code *code);
 tree gfc_trans_oacc_directive (gfc_code *);
 tree gfc_trans_oacc_declare (gfc_namespace *);
 
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index a377d0eeb24..007ee65a169 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_MASTER:
 	case EXEC_OMP_MASTER_TASKLOOP:
 	case EXEC_OMP_MASTER_TASKLOOP_SIMD:
+	case EXEC_OMP_METADIRECTIVE:
 	case EXEC_OMP_ORDERED:
 	case EXEC_OMP_PARALLEL:
 	case EXEC_OMP_PARALLEL_DO:
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 6340d1600a6..5a8a34573c8 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -1198,7 +1198,7 @@ omp_check_context_selector (location_t loc, tree ctx)
 		      const char *str = TREE_STRING_POINTER (TREE_VALUE (t2));
 		      if (!strcmp (str, props[i].props[j])
 			  && ((size_t) TREE_STRING_LENGTH (TREE_VALUE (t2))
-			      == strlen (str) + (lang_GNU_Fortran () ? 0 : 1)))
+			      == strlen (str) + 1))
 			break;
 		    }
 		  else if (!strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t2)),
@@ -1247,8 +1247,7 @@ omp_context_name_list_prop (tree prop)
   else
     {
       const char *ret = TREE_STRING_POINTER (TREE_VALUE (prop));
-      if ((size_t) TREE_STRING_LENGTH (TREE_VALUE (prop))
-	  == strlen (ret) + (lang_GNU_Fortran () ? 0 : 1))
+      if ((size_t) TREE_STRING_LENGTH (TREE_VALUE (prop)) == strlen (ret) + 1)
 	return ret;
       return NULL;
     }
-- 
2.25.1

Re: [PATCH 6/7] openmp, fortran: Add Fortran support for parsing metadirectives

[Kwok Cheung Yeung]

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

 > This patch implements metadirective parsing in the Fortran frontend.

This patch (to be applied on top of the current set of metadirective 
patches) implements a feature that was present in the C and C++ 
front-ends but not in Fortran - the early culling of metadirective 
variants that can be eliminated during parsing because their selectors 
are resolvable at parse-time and still do not match. This is more 
efficient, and allows code with nested metadirectives like this (which 
works on other compilers) to compile:

!$omp metadirective when (implementation={vendor("ibm")}: &
!$omp&  target teams distribute)
   !$omp metadirective when (implementation={vendor("gnu")}: parallel do)

This would currently fail because when parsing the body of the 'target 
teams distribute', the parser sees the metadirective when it is 
expecting a loop nest. If the vendor("ibm") is eliminated early though, 
it would just evaluate to '!$omp nothing' and the following 
metadirective would not be incorrect. This doesn't work for selectors 
such as 'arch' that would need to be deferred until later passes though.

As the selector matching code (omp_context_selector_matches in 
omp-general.cc) works on Generic trees, I have allowed for a limited 
translation from the GFortran AST form to tree form during parsing, 
skipping over things like expression translation that must be done later.

I have also fixed another FE issue with nested metadirectives, that 
occurs when you have something like:

program P
   !$omp metadirective
     !$omp metadirective
       !$omp metadirective
         <do statement>
end program P

When gfc_match_end is called after parsing the do statement, it needs to 
drop down multiple levels from the innermost metadirective state to that 
  of 'program P' in order to find the proper end type, and not just one 
level as it currently does.

Thanks

Kwok

[-- Attachment #2: 0001-openmp-Eliminate-non-matching-metadirective-variants.patch --]
[-- Type: text/plain, Size: 7909 bytes --]

From 5a7b109a014422a5b43e43669df1dc0d59e830cf Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 11 Feb 2022 11:20:18 +0000
Subject: [PATCH 1/2] openmp: Eliminate non-matching metadirective variants
 early in Fortran front-end

This patch checks during parsing if a metadirective selector is both
resolvable and non-matching - if so, it is removed from further
consideration.  This is both more efficient, and avoids spurious
syntax errors caused by considering combinations of selectors that
lead to invalid combinations of OpenMP directives, when that
combination would never arise in the first place.

This exposes another bug - when metadirectives that are not of the
begin-end variety are nested, we might have to drill up through
multiple layers of the state stack to reach the state for the
next statement.  This is now fixed.

2022-02-11  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* omp-general.cc (DELAY_METADIRECTIVES_AFTER_LTO): Check that cfun is
	non-null before derefencing.

	gcc/fortran/
	* decl.cc (gfc_match_end): Search for first previous state that is not
	COMP_OMP_METADIRECTIVE.
	* gfortran.h (gfc_skip_omp_metadirective_clause): Add prototype.
	* openmp.cc (match_omp_metadirective): Skip clause if
	result of gfc_skip_omp_metadirective_clause is true.
	* trans-openmp.cc (gfc_trans_omp_set_selector): Add argument and
	disable	expression conversion if false.
	(gfc_skip_omp_metadirective_clause): New.

	gcc/testsuite/
	* gfortran.dg/gomp/metadirective-8.f90: New.
---
 gcc/fortran/decl.cc                           | 21 +++++++++-
 gcc/fortran/gfortran.h                        |  4 ++
 gcc/fortran/openmp.cc                         |  7 +++-
 gcc/fortran/trans-openmp.cc                   | 38 ++++++++++++++-----
 gcc/omp-general.cc                            |  5 ++-
 .../gfortran.dg/gomp/metadirective-8.f90      | 22 +++++++++++
 6 files changed, 81 insertions(+), 16 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90

diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index e024e360c88..a77ac768175 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -8325,15 +8325,32 @@ gfc_match_end (gfc_statement *st)
 
     case COMP_CONTAINS:
     case COMP_DERIVED_CONTAINS:
-    case COMP_OMP_METADIRECTIVE:
     case COMP_OMP_BEGIN_METADIRECTIVE:
       state = gfc_state_stack->previous->state;
       block_name = gfc_state_stack->previous->sym == NULL
-		 ? NULL : gfc_state_stack->previous->sym->name;
+		   ? NULL : gfc_state_stack->previous->sym->name;
       abreviated_modproc_decl = gfc_state_stack->previous->sym
 		&& gfc_state_stack->previous->sym->abr_modproc_decl;
       break;
 
+    case COMP_OMP_METADIRECTIVE:
+      {
+	/* Metadirectives can be nested, so we need to drill down to the
+	   first state that is not COMP_OMP_METADIRECTIVE.  */
+	gfc_state_data *state_data = gfc_state_stack;
+
+	do
+	{
+	  state_data = state_data->previous;
+	  state = state_data->state;
+	  block_name = state_data->sym == NULL
+		       ? NULL : state_data->sym->name;
+	  abreviated_modproc_decl = state_data->sym
+		&& state_data->sym->abr_modproc_decl;
+	}
+	while (state == COMP_OMP_METADIRECTIVE);
+      }
+      break;
     default:
       break;
     }
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 3d8c65ff1be..bdb4b0f6aa5 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3940,4 +3940,8 @@ bool gfc_is_reallocatable_lhs (gfc_expr *);
 void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool);
 void gfc_adjust_builtins (void);
 
+/* trans-openmp.c */
+
+bool gfc_skip_omp_metadirective_clause (gfc_omp_metadirective_clause *);
+
 #endif /* GCC_GFORTRAN_H  */
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 1a97a62462f..5e87e18ce0d 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -5195,8 +5195,11 @@ match_omp_metadirective (bool begin_p)
 	  new_st.ext.omp_clauses = NULL;
 	}
 
-      *next_clause = omc;
-      next_clause = &omc->next;
+      if (!gfc_skip_omp_metadirective_clause (omc))
+	{
+	  *next_clause = omc;
+	  next_clause = &omc->next;
+	}
     }
 
   if (gfc_match_omp_eos () != MATCH_YES)
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index a19d916d98c..84e569d2664 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -7499,7 +7499,8 @@ gfc_trans_omp_declare_simd (gfc_namespace *ns)
 }
 
 static tree
-gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
+gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where,
+			    bool conv_expr_p = true)
 {
   tree set_selectors = NULL_TREE;
   gfc_omp_set_selector *oss;
@@ -7520,11 +7521,15 @@ gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
 		case CTX_PROPERTY_USER:
 		case CTX_PROPERTY_EXPR:
 		  {
-		    gfc_se se;
-		    gfc_init_se (&se, NULL);
-		    gfc_conv_expr (&se, otp->expr);
-		    properties = tree_cons (NULL_TREE, se.expr,
-					    properties);
+		    tree expr = NULL_TREE;
+		    if (conv_expr_p)
+		      {
+			gfc_se se;
+			gfc_init_se (&se, NULL);
+			gfc_conv_expr (&se, otp->expr);
+			expr = se.expr;
+		      }
+		    properties = tree_cons (NULL_TREE, expr, properties);
 		  }
 		  break;
 		case CTX_PROPERTY_ID:
@@ -7560,11 +7565,16 @@ gfc_trans_omp_set_selector (gfc_omp_set_selector *gfc_selectors, locus where)
 
 	  if (os->score)
 	    {
-	      gfc_se se;
-	      gfc_init_se (&se, NULL);
-	      gfc_conv_expr (&se, os->score);
+	      tree expr = NULL_TREE;
+	      if (conv_expr_p)
+		{
+		  gfc_se se;
+		  gfc_init_se (&se, NULL);
+		  gfc_conv_expr (&se, os->score);
+		  expr = se.expr;
+		}
 	      properties = tree_cons (get_identifier (" score"),
-				      se.expr, properties);
+				      expr, properties);
 	    }
 
 	  selectors = tree_cons (get_identifier (os->trait_selector_name),
@@ -7755,3 +7765,11 @@ gfc_trans_omp_metadirective (gfc_code *code)
 
   return metadirective_tree;
 }
+
+bool gfc_skip_omp_metadirective_clause (gfc_omp_metadirective_clause *clause)
+{
+  tree selector = gfc_trans_omp_set_selector (clause->selectors,
+					      clause->where, false);
+
+  return omp_context_selector_matches (selector, true) == 0;
+}
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 842e9fd868f..b032e1de697 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1254,8 +1254,9 @@ omp_context_name_list_prop (tree prop)
 }
 
 #define DELAY_METADIRECTIVES_AFTER_LTO { \
-  if (metadirective_p && !(cfun->curr_properties & PROP_gimple_lomp_dev))	\
-    return -1;	\
+  if (metadirective_p \
+      && !(cfun && cfun->curr_properties & PROP_gimple_lomp_dev)) \
+    return -1; \
 }
 
 /* Return 1 if context selector matches the current OpenMP context, 0
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
new file mode 100644
index 00000000000..e1347910332
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-8.f90
@@ -0,0 +1,22 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+program test
+  integer :: i
+  integer, parameter :: N = 100
+  integer :: sum = 0
+  
+  ! The compiler should never consider a situation where both metadirectives
+  ! match.  If it does, then the nested metadirective would be an error
+  ! as it is not a loop-nest as per the OpenMP specification.
+
+  !$omp metadirective when (implementation={vendor("ibm")}: &
+  !$omp&  target teams distribute)
+    !$omp metadirective when (implementation={vendor("gnu")}: parallel do)
+      do i = 1, N
+	sum = sum + i
+      end do
+end program
+
+! { dg-final { scan-tree-dump-not "when \\(implementation vendor \"ibm\"\\):" "original" } }
+! { dg-final { scan-tree-dump-times "when \\(implementation vendor \"gnu\"\\):" 1 "original" } }
-- 
2.25.1

Re: [PATCH 6/7] openmp, fortran: Add Fortran support for parsing metadirectives

[Kwok Cheung Yeung]

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

This patch (again, to be applied on top of the current set of 
metadirective patches) fixes two minor issues with metadirectives in the 
Fortran front-end.

- 'sorry' is called if a declarative OpenMP directive is found in a 
metadirective clause.
- An ICE that occurs with an empty metadirective (i.e. just '!$omp 
metadirective' with nothing else) is fixed.

Thanks

Kwok

[-- Attachment #2: 0002-openmp-More-Fortran-front-end-fixes-for-metadirectiv.patch --]
[-- Type: text/plain, Size: 3653 bytes --]

From 153b8dbd19cf90b1869be7f409d55d1ab5ba81d5 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 11 Feb 2022 15:42:50 +0000
Subject: [PATCH 2/2] openmp: More Fortran front-end fixes for metadirectives

This adds a check for declarative OpenMP directives in metadirective
variants (already present in the C/C++ front-ends), and fixes an
ICE when an empty metadirective (i.e. just '!$omp metadirective')
is presented.

2022-02-11  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/fortran/
	* gfortran.h (is_omp_declarative_stmt): New.
	* openmp.cc (match_omp_metadirective): Reject declarative OpenMP
	directives with 'sorry'.
	* parse.cc (parse_omp_metadirective_body): Check that state stack head
	is non-null before dereferencing.
	(is_omp_declarative_stmt): New.

	gcc/testsuite/
	* gfortran.dg/gomp/metadirective-2.f90 (main): Test empty
	metadirective.
---
 gcc/fortran/gfortran.h                           |  1 +
 gcc/fortran/openmp.cc                            |  3 +++
 gcc/fortran/parse.cc                             | 16 +++++++++++++++-
 .../gfortran.dg/gomp/metadirective-2.f90         |  5 ++++-
 4 files changed, 23 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bdb4b0f6aa5..37eb039b6d4 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -3852,6 +3852,7 @@ bool gfc_parse_file (void);
 void gfc_global_used (gfc_gsymbol *, locus *);
 gfc_namespace* gfc_build_block_ns (gfc_namespace *);
 gfc_statement match_omp_directive (void);
+bool is_omp_declarative_stmt (gfc_statement);
 
 /* dependency.cc */
 int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 5e87e18ce0d..0071484817d 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -5151,6 +5151,9 @@ match_omp_metadirective (bool begin_p)
       gfc_statement directive = match_omp_directive ();
       gfc_matching_omp_context_selector = false;
 
+      if (is_omp_declarative_stmt (directive))
+	sorry ("declarative directive variants are not supported");
+
       if (gfc_error_flag_test ())
 	{
 	  gfc_current_locus = old_loc;
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index cd18315697e..cb8acb3c68f 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -5841,7 +5841,8 @@ parse_omp_metadirective_body (gfc_statement omp_st)
 
       gfc_in_metadirective_body = old_in_metadirective_body;
 
-      *clause->code = *gfc_state_stack->head;
+      if (gfc_state_stack->head)
+	*clause->code = *gfc_state_stack->head;
       pop_state ();
 
       gfc_commit_symbols ();
@@ -7081,3 +7082,16 @@ is_oacc (gfc_state_data *sd)
       return false;
     }
 }
+
+/* Return true if ST is a declarative OpenMP statement.  */
+bool
+is_omp_declarative_stmt (gfc_statement st)
+{
+  switch (st)
+    {
+      case_omp_decl:
+	return true;
+      default:
+	return false;
+    }
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
index 06c324589d0..cdd5e85068e 100644
--- a/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
@@ -43,7 +43,7 @@ program main
     end do
   !$omp end metadirective
   
-  ! Test labels in the body
+  ! Test labels in the body.
   !$omp begin metadirective &
   !$omp&	when (device={arch("nvptx")}: parallel do) &
   !$omp&	when (device={arch("gcn")}: parallel)
@@ -56,4 +56,7 @@ program main
 20    continue
     end do
   !$omp end metadirective
+
+  ! Test empty metadirective.
+  !$omp metadirective
 end program
-- 
2.25.1

[PATCH 7/7] openmp: Add testcases for metadirectives

[Kwok Cheung Yeung]

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

This adds testcases for metadirectives.

Kwok

[-- Attachment #2: 0007-openmp-Add-testcases-for-metadirectives.patch --]
[-- Type: text/plain, Size: 30942 bytes --]

From d3f80b603298fb2f3501a28b888acfdbc02a64e7 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Tue, 7 Dec 2021 11:25:33 +0000
Subject: [PATCH 7/7] openmp: Add testcases for metadirectives

2021-12-10  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/testsuite/
	* c-c++-common/gomp/metadirective-1.c: New.
	* c-c++-common/gomp/metadirective-2.c: New.
	* c-c++-common/gomp/metadirective-3.c: New.
	* c-c++-common/gomp/metadirective-4.c: New.
	* c-c++-common/gomp/metadirective-5.c: New.
	* c-c++-common/gomp/metadirective-6.c: New.
	* gcc.dg/gomp/metadirective-1.c: New.
	* gfortran.dg/gomp/metadirective-1.f90: New.
	* gfortran.dg/gomp/metadirective-2.f90: New.
	* gfortran.dg/gomp/metadirective-3.f90: New.
	* gfortran.dg/gomp/metadirective-4.f90: New.
	* gfortran.dg/gomp/metadirective-5.f90: New.
	* gfortran.dg/gomp/metadirective-6.f90: New.

	libgomp/
	* testsuite/libgomp.c-c++-common/metadirective-1.c: New.
	* testsuite/libgomp.c-c++-common/metadirective-2.c: New.
	* testsuite/libgomp.c-c++-common/metadirective-3.c: New.
	* testsuite/libgomp.c-c++-common/metadirective-4.c: New.
	* testsuite/libgomp.fortran/metadirective-1.f90: New.
	* testsuite/libgomp.fortran/metadirective-2.f90: New.
	* testsuite/libgomp.fortran/metadirective-3.f90: New.
	* testsuite/libgomp.fortran/metadirective-4.f90: New.
---
 .../c-c++-common/gomp/metadirective-1.c       | 29 ++++++++
 .../c-c++-common/gomp/metadirective-2.c       | 74 +++++++++++++++++++
 .../c-c++-common/gomp/metadirective-3.c       | 31 ++++++++
 .../c-c++-common/gomp/metadirective-4.c       | 40 ++++++++++
 .../c-c++-common/gomp/metadirective-5.c       | 24 ++++++
 .../c-c++-common/gomp/metadirective-6.c       | 31 ++++++++
 gcc/testsuite/gcc.dg/gomp/metadirective-1.c   | 15 ++++
 .../gfortran.dg/gomp/metadirective-1.f90      | 41 ++++++++++
 .../gfortran.dg/gomp/metadirective-2.f90      | 59 +++++++++++++++
 .../gfortran.dg/gomp/metadirective-3.f90      | 34 +++++++++
 .../gfortran.dg/gomp/metadirective-4.f90      | 39 ++++++++++
 .../gfortran.dg/gomp/metadirective-5.f90      | 30 ++++++++
 .../gfortran.dg/gomp/metadirective-6.f90      | 31 ++++++++
 .../libgomp.c-c++-common/metadirective-1.c    | 35 +++++++++
 .../libgomp.c-c++-common/metadirective-2.c    | 41 ++++++++++
 .../libgomp.c-c++-common/metadirective-3.c    | 34 +++++++++
 .../libgomp.c-c++-common/metadirective-4.c    | 52 +++++++++++++
 .../libgomp.fortran/metadirective-1.f90       | 33 +++++++++
 .../libgomp.fortran/metadirective-2.f90       | 40 ++++++++++
 .../libgomp.fortran/metadirective-3.f90       | 29 ++++++++
 .../libgomp.fortran/metadirective-4.f90       | 46 ++++++++++++
 21 files changed, 788 insertions(+)
 create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-1.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-2.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-3.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-4.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-5.c
 create mode 100644 gcc/testsuite/c-c++-common/gomp/metadirective-6.c
 create mode 100644 gcc/testsuite/gcc.dg/gomp/metadirective-1.c
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
 create mode 100644 gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
 create mode 100644 libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
 create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-1.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-2.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-3.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/metadirective-4.f90

diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-1.c b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
new file mode 100644
index 00000000000..72cf0abbbd7
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
@@ -0,0 +1,29 @@
+/* { dg-do compile } */
+
+#define N 100
+
+void f (int a[], int b[], int c[])
+{
+  #pragma omp metadirective \
+      default (teams loop) \
+      default (parallel loop) /* { dg-error "there can only be one default clause in a metadirective before '\\(' token" } */
+    for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+  #pragma omp metadirective \
+      default (bad_directive) /* { dg-error "unknown directive name before '\\)' token" } */
+    for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+  #pragma omp metadirective \
+      default (teams loop) \
+      where (device={arch("nvptx")}: parallel loop) /* { dg-error "expected 'when' or 'default' before '\\(' token" } */
+    for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+  #pragma omp metadirective \
+      default (teams loop) \
+      when (device={arch("nvptx")} parallel loop) /* { dg-error "expected colon before 'parallel'" } */
+    for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+
+  #pragma omp metadirective \
+	default (metadirective default (flush))	/* { dg-error "metadirectives cannot be used as directive variants before 'default'" } */
+    for (i = 0; i < N; i++) c[i] = a[i] * b[i];
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-2.c b/gcc/testsuite/c-c++-common/gomp/metadirective-2.c
new file mode 100644
index 00000000000..ea6904c9c12
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-2.c
@@ -0,0 +1,74 @@
+/* { dg-do compile } */
+
+#define N 100
+
+int main (void)
+{
+  int x = 0;
+  int y = 0;
+
+  /* Test implicit default (nothing).  */
+  #pragma omp metadirective \
+      when (device={arch("nvptx")}: barrier)
+    x = 1;
+
+  /* Test with multiple standalone directives.  */
+  #pragma omp metadirective \
+      when (device={arch("nvptx")}: barrier) \
+      default (flush)
+    x = 1;
+
+  /* Test combining a standalone directive with one that takes a statement
+     body.  */
+  #pragma omp metadirective \
+      when (device={arch("nvptx")}: parallel) \
+      default (barrier)
+    x = 1;
+
+  /* Test combining a standalone directive with one that takes a for loop.  */
+  #pragma omp metadirective \
+      when (device={arch("nvptx")}: parallel for) \
+      default (barrier)
+    for (int i = 0; i < N; i++)
+      x += i;
+
+  /* Test combining a directive that takes a for loop with one that takes
+     a regular statement body.  */
+  #pragma omp metadirective \
+      when (device={arch("nvptx")}: parallel for) \
+      default (parallel)
+    for (int i = 0; i < N; i++)
+      x += i;
+
+  /* Test labels inside statement body.  */
+  #pragma omp metadirective \
+    when (device={arch("nvptx")}: teams num_teams(512)) \
+    when (device={arch("gcn")}: teams num_teams(256)) \
+    default (teams num_teams(4))
+  {
+    if (x)
+      goto l1;
+    else
+      goto l2;
+  l1: ;
+  l2: ;
+  }
+
+  /* Test local labels inside statement body.  */
+  #pragma omp metadirective \
+    when (device={arch("nvptx")}: teams num_teams(512)) \
+    when (device={arch("gcn")}: teams num_teams(256)) \
+    default (teams num_teams(4))
+  {
+    //__label__ l1, l2;
+
+    if (x)
+      goto l1;
+    else
+      goto l2;
+  l1: ;
+  l2: ;
+  }
+
+  return 0;
+}
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-3.c b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
new file mode 100644
index 00000000000..80c93b1521d
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
@@ -0,0 +1,31 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+/* { dg-additional-options "-fdump-tree-optimized" } */
+
+#define N 100
+
+void f (int x[], int y[], int z[])
+{
+  int i;
+
+  #pragma omp target map(to: x, y) map(from: z)
+    #pragma omp metadirective \
+	when (device={arch("nvptx")}: teams loop) \
+	default (parallel loop)
+      for (i = 0; i < N; i++)
+	z[i] = x[i] * y[i];
+}
+
+/* The metadirective should be resolved after Gimplification.  */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(device arch .nvptx.\\):" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-4.c b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
new file mode 100644
index 00000000000..c4b109295db
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
@@ -0,0 +1,40 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+
+#pragma omp declare target
+void f(double a[], double x) {
+  int i;
+
+  #pragma omp metadirective \
+	when (construct={target}: distribute parallel for) \
+	default (parallel for simd)
+   for (i = 0; i < N; i++)
+     a[i] = x * i;
+}
+#pragma omp end declare target
+
+ int main()
+{
+  double a[N];
+
+  #pragma omp target teams map(from: a[0:N])
+    f (a, 3.14159);
+
+  /* TODO: This does not execute a version of f with the default clause
+     active as might be expected.  */
+  f (a, 2.71828);
+
+  return 0;
+ }
+
+ /* The metadirective should be resolved during Gimplification.  */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(construct target.*\\):" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-5.c b/gcc/testsuite/c-c++-common/gomp/metadirective-5.c
new file mode 100644
index 00000000000..4a9f1aa85a6
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-5.c
@@ -0,0 +1,24 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+
+#define N 100
+
+void f (int a[], int flag)
+{
+  int i;
+  #pragma omp metadirective \
+	when (user={condition(flag)}: \
+		target teams distribute parallel for map(from: a[0:N])) \
+	default (parallel for)
+  for (i = 0; i < N; i++)
+    a[i] = i;
+}
+
+/* The metadirective should be resolved at parse time.  */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp target" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times  "#pragma omp distribute" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp for" 2 "original" } } */
diff --git a/gcc/testsuite/c-c++-common/gomp/metadirective-6.c b/gcc/testsuite/c-c++-common/gomp/metadirective-6.c
new file mode 100644
index 00000000000..c77c0065e17
--- /dev/null
+++ b/gcc/testsuite/c-c++-common/gomp/metadirective-6.c
@@ -0,0 +1,31 @@
+/* { dg-do compile } */
+/* { dg-additional-options "-fdump-tree-original" } */
+/* { dg-additional-options "-fdump-tree-gimple" } */
+
+#define N 100
+
+void bar (int a[], int run_parallel, int run_guided)
+{
+  #pragma omp metadirective \
+	when (user={condition(run_parallel)}: parallel)
+  {
+    int i;
+    #pragma omp metadirective \
+	when (construct={parallel}, user={condition(run_guided)}: \
+	      for schedule(guided)) \
+	when (construct={parallel}: for schedule(static))
+      for (i = 0; i < N; i++)
+	a[i] = i;
+   }
+ }
+
+/* The outer metadirective should be resolved at parse time.  */
+/* The inner metadirective should be resolved during Gimplificiation.  */
+
+/* { dg-final { scan-tree-dump-times "#pragma omp metadirective" 2 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } } */
+/* { dg-final { scan-tree-dump-times "#pragma omp for" 4 "original" } } */
+/* { dg-final { scan-tree-dump-times "when \\(construct parallel" 4 "original" } } */
+/* { dg-final { scan-tree-dump-times "default:" 2 "original" } } */
+
+/* { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } } */
diff --git a/gcc/testsuite/gcc.dg/gomp/metadirective-1.c b/gcc/testsuite/gcc.dg/gomp/metadirective-1.c
new file mode 100644
index 00000000000..2ac81bfde75
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/gomp/metadirective-1.c
@@ -0,0 +1,15 @@
+int main (void)
+{
+  int x, y;
+
+  /* Test nested functions inside statement body.  */
+  #pragma omp metadirective \
+    when (device={arch("nvptx")}: teams num_teams(512)) \
+    when (device={arch("gcn")}: teams num_teams(256)) \
+    default (teams num_teams(4))
+  {
+    int f (int x) { return x * 3; }
+
+    y = f (x);
+  }
+}
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
new file mode 100644
index 00000000000..aa439fc855e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-1.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+
+program main
+  integer, parameter :: N = 10
+  integer, dimension(N) :: a
+  integer, dimension(N) :: b
+  integer, dimension(N) :: c
+  integer :: i
+
+  do i = 1, N
+    a(i) = i * 2
+    b(i) = i * 3
+  end do
+
+  !$omp metadirective &
+  !$omp&	default (teams loop) &
+  !$omp&	default (parallel loop)	! { dg-error "there can only be one default clause in a metadirective at .1." }
+    do i = 1, N
+      c(i) = a(i) * b(i)
+    end do
+
+  !$omp metadirective default (xyz) ! { dg-error "Unclassifiable OpenMP directive at .1." }
+    do i = 1, N
+      c(i) = a(i) * b(i)
+    end do
+
+  !$omp metadirective &
+  !$omp&	default (teams loop) & ! { dg-error "expected 'default' or 'when' at .1." }
+  !$omp&	where (device={arch("nvptx")}: parallel loop)
+    do i = 1, N
+      c(i) = a(i) * b(i)
+    end do
+    
+  !$omp begin metadirective &
+  !$omp&	when (device={arch("nvptx")}: parallel do) &
+  !$omp&	default (barrier) ! { dg-error "variant directive used in OMP BEGIN METADIRECTIVE at .1. must have a corresponding end directive" }
+    do i = 1, N
+      c(i) = a(i) * b(i)
+    end do
+  !$omp end metadirective ! { dg-error "Unexpected !OMP END METADIRECTIVE statement at .1." }
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
new file mode 100644
index 00000000000..06c324589d0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-2.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+
+program main
+  integer, parameter :: N = 100
+  integer :: x = 0
+  integer :: y = 0
+  integer :: i
+
+  ! Test implicit default directive
+  !$omp metadirective &
+  !$omp&	when (device={arch("nvptx")}: barrier)
+    x = 1
+
+  ! Test implicit default directive combined with a directive that takes a
+  ! do loop.
+  !$omp metadirective &
+  !$omp&	when (device={arch("nvptx")}: parallel do)
+    do i = 1, N
+      x = x + i
+    end do
+
+  ! Test with multiple standalone directives.
+  !$omp metadirective &
+  !$omp&	when (device={arch("nvptx")}: barrier) &
+  !$omp&	default (flush)
+    x = 1
+
+  ! Test combining a standalone directive with one that takes a do loop.
+  !$omp metadirective &
+  !$omp&	when (device={arch("nvptx")}: parallel do) &
+  !$omp&	default (barrier)
+    do i = 1, N
+      x = x + i
+    end do
+
+  ! Test combining a directive that takes a do loop with one that takes
+  ! a statement body.
+  !$omp begin metadirective &
+  !$omp&	when (device={arch("nvptx")}: parallel do) &
+  !$omp&	default (parallel)
+    do i = 1, N
+      x = x + i
+    end do
+  !$omp end metadirective
+  
+  ! Test labels in the body
+  !$omp begin metadirective &
+  !$omp&	when (device={arch("nvptx")}: parallel do) &
+  !$omp&	when (device={arch("gcn")}: parallel)
+    do i = 1, N
+      x = x + i
+      if (x .gt. N/2) goto 10
+10    x = x + 1
+      goto 20
+      x = x + 2
+20    continue
+    end do
+  !$omp end metadirective
+end program
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
new file mode 100644
index 00000000000..c36a462bf51
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-3.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-fdump-tree-gimple" }
+! { dg-additional-options "-fdump-tree-optimized" }
+
+module test
+  integer, parameter :: N = 100
+contains
+  subroutine f (x, y, z)
+    integer :: x(N), y(N), z(N)
+
+    !$omp target map (to: v1, v2) map(from: v3)
+      !$omp metadirective &
+		!$omp& when(device={arch("nvptx")}: teams loop) &
+		!$omp& default(parallel loop)
+	do i = 1, N
+	  z(i) = x(i) * y(i)
+	enddo
+    !$omp end target
+  end subroutine
+end module
+
+! The metadirective should be resolved after Gimplification.
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } }
+! { dg-final { scan-tree-dump-times "when \\(device arch .nvptx.\\):" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "original" } }
+! { dg-final { scan-tree-dump-times "default:" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp loop" 2 "original" } }
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "gimple" } }
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
new file mode 100644
index 00000000000..b82c9ea96d9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-4.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+program test
+  implicit none
+  integer, parameter :: N = 100
+  real :: a(N)
+  
+  !$omp target map(from: a)
+    call f (a, 3.14159)
+  !$omp end target
+
+  ! TODO: This does not execute a version of f with the default clause
+  ! active as might be expected.
+  call f (a, 2.71828)
+contains
+  subroutine f (a, x)
+    integer :: i
+    real :: a(N), x
+    !$omp declare target
+
+    !$omp metadirective &
+    !$omp&  when (construct={target}: distribute parallel do ) &
+    !$omp&  default(parallel do simd)
+      do i = 1, N
+ 	a(i) = x * i
+      end do
+  end subroutine
+end program
+
+! The metadirective should be resolved during Gimplification.
+
+! { dg-final { scan-tree-dump-times "#pragma omp metadirective" 1 "original" } }
+! { dg-final { scan-tree-dump-times "when \\(construct target.*\\):" 1 "original" } }
+! { dg-final { scan-tree-dump-times "default:" 1 "original" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "original" } }
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
new file mode 100644
index 00000000000..03970393eb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-5.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+module test
+  integer, parameter :: N = 100
+contains
+  subroutine f (a, flag)
+    integer :: a(N)
+    logical :: flag
+    integer :: i
+    
+   !$omp metadirective &
+   !$omp&  when (user={condition(flag)}: &
+   !$omp&	 target teams distribute parallel do map(from: a(1:N))) &
+   !$omp&  default(parallel do)
+     do i = 1, N
+       a(i) = i
+     end do
+  end subroutine
+end module
+
+! The metadirective should be resolved at parse time, but is currently
+! resolved during Gimplification
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp target" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp teams" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times  "#pragma omp distribute" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 2 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for" 2 "gimple" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90 b/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
new file mode 100644
index 00000000000..9b6c371296f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/metadirective-6.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-gimple" }
+
+module test
+  integer, parameter :: N = 100
+contains
+  subroutine f (a, run_parallel, run_guided)
+    integer :: a(N)
+    logical :: run_parallel, run_guided
+    integer :: i
+
+    !$omp begin metadirective when(user={condition(run_parallel)}: parallel)
+      !$omp metadirective &
+      !$omp&  when(construct={parallel}, user={condition(run_guided)}: &
+      !$omp&       do schedule(guided)) &
+      !$omp&  when(construct={parallel}: do schedule(static))
+	do i = 1, N
+	  a(i) = i
+	end do
+    !$omp end metadirective
+  end subroutine
+end module
+
+! The outer metadirective should be resolved at parse time, but is
+! currently resolved during Gimplification.
+
+! The inner metadirective should be resolved during Gimplificiation.
+
+! { dg-final { scan-tree-dump-not "#pragma omp metadirective" "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp parallel" 1 "gimple" } }
+! { dg-final { scan-tree-dump-times "#pragma omp for" 2 "gimple" } }
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
new file mode 100644
index 00000000000..0de59cbe3d3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
@@ -0,0 +1,35 @@
+/* { dg-do run } */
+
+#define N 100
+
+void f (int x[], int y[], int z[])
+{
+  int i;
+
+  #pragma omp target map(to: x[0:N], y[0:N]) map(from: z[0:N])
+    #pragma omp metadirective \
+	when (device={arch("nvptx")}: teams loop) \
+	default (parallel loop)
+      for (i = 0; i < N; i++)
+	z[i] = x[i] * y[i];
+}
+
+int main (void)
+{
+  int x[N], y[N], z[N];
+  int i;
+
+  for (i = 0; i < N; i++)
+    {
+      x[i] = i;
+      y[i] = -i;
+    }
+
+  f (x, y, z);
+
+  for (i = 0; i < N; i++)
+    if (z[i] != x[i] * y[i])
+      return 1;
+
+  return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
new file mode 100644
index 00000000000..cd5c6c5e21a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-2.c
@@ -0,0 +1,41 @@
+/* { dg-do run } */
+
+#include <math.h>
+
+#define N 100
+#define EPSILON 0.001
+
+#pragma omp declare target
+void f(double a[], double x) {
+  int i;
+
+  #pragma omp metadirective \
+	when (construct={target}: distribute parallel for) \
+	default (parallel for simd)
+   for (i = 0; i < N; i++)
+     a[i] = x * i;
+}
+#pragma omp end declare target
+
+ int main()
+{
+  double a[N];
+  int i;
+
+  #pragma omp target teams map(from: a[0:N])
+    f (a, M_PI);
+
+  for (i = 0; i < N; i++)
+    if (fabs (a[i] - (M_PI * i)) > EPSILON)
+      return 1;
+
+  /* TODO: This does not execute a version of f with the default clause
+     active as might be expected.  */
+  f (a, M_E);
+
+  for (i = 0; i < N; i++)
+    if (fabs (a[i] - (M_E * i)) > EPSILON)
+      return 1;
+
+  return 0;
+ }
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
new file mode 100644
index 00000000000..e31daf2cb64
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-3.c
@@ -0,0 +1,34 @@
+/* { dg-do run } */
+
+#define N 100
+
+int f (int a[], int flag)
+{
+  int i;
+  int res = 0;
+
+  #pragma omp metadirective \
+	when (user={condition(!flag)}: \
+		target teams distribute parallel for \
+		  map(from: a[0:N]) private(res)) \
+	default (parallel for)
+  for (i = 0; i < N; i++)
+    {
+      a[i] = i;
+      res = 1;
+    }
+
+  return res;
+}
+
+int main (void)
+{
+  int a[N];
+
+  if (f (a, 0))
+    return 1;
+  if (!f (a, 1))
+    return 1;
+
+  return 0;
+}
diff --git a/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c b/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
new file mode 100644
index 00000000000..7fc601eaba6
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-4.c
@@ -0,0 +1,52 @@
+/* { dg-do run } */
+
+#include <omp.h>
+
+#define N 100
+
+int f (int a[], int run_parallel, int run_static)
+{
+  int is_parallel = 0;
+  int is_static = 0;
+
+  #pragma omp metadirective \
+	when (user={condition(run_parallel)}: parallel)
+  {
+    int i;
+
+    if (omp_in_parallel ())
+      is_parallel = 1;
+
+    #pragma omp metadirective \
+	when (construct={parallel}, user={condition(!run_static)}: \
+	      for schedule(guided) private(is_static)) \
+	when (construct={parallel}: for schedule(static))
+      for (i = 0; i < N; i++)
+	{
+	  a[i] = i;
+	  is_static = 1;
+	}
+   }
+
+  return (is_parallel << 1) | is_static;
+}
+
+int main (void)
+{
+  int a[N];
+
+  /* is_static is always set if run_parallel is false.  */
+  if (f (a, 0, 0) != 1)
+    return 1;
+
+  if (f (a, 0, 1) != 1)
+    return 1;
+
+  if (f (a, 1, 0) != 2)
+    return 1;
+
+  if (f (a, 1, 1) != 3)
+    return 1;
+
+  return 0;
+}
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-1.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
new file mode 100644
index 00000000000..9f6a07459e0
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-1.f90
@@ -0,0 +1,33 @@
+! { dg-do run }
+
+program test
+  implicit none
+
+  integer, parameter :: N = 100
+  integer :: x(N), y(N), z(N)
+  integer :: i
+
+  do i = 1, N
+    x(i) = i;
+    y(i) = -i;
+  end do
+
+  call f (x, y, z)
+
+  do i = 1, N
+    if (z(i) .ne. x(i) * y(i)) stop 1
+  end do
+contains
+  subroutine f (x, y, z)
+    integer :: x(N), y(N), z(N)
+
+    !$omp target map (to: x, y) map(from: z)
+      !$omp metadirective &
+		!$omp& when(device={arch("nvptx")}: teams loop) &
+		!$omp& default(parallel loop)
+	do i = 1, N
+	  z(i) = x(i) * y(i)
+	enddo
+    !$omp end target
+  end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-2.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
new file mode 100644
index 00000000000..32017a00077
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-2.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+
+program test
+  implicit none
+  integer, parameter :: N = 100
+  real, parameter :: PI_CONST = 3.14159
+  real, parameter :: E_CONST = 2.71828
+  real, parameter :: EPSILON = 0.001
+  integer :: i
+  real :: a(N)
+
+  !$omp target map(from: a)
+    call f (a, PI_CONST)
+  !$omp end target
+
+  do i = 1, N
+    if (abs (a(i) - (PI_CONST * i)) .gt. EPSILON) stop 1
+  end do
+
+  ! TODO: This does not execute a version of f with the default clause
+  ! active as might be expected.
+  call f (a, E_CONST)
+
+  do i = 1, N
+    if (abs (a(i) - (E_CONST * i)) .gt. EPSILON) stop 2
+  end do
+contains
+  subroutine f (a, x)
+    integer :: i
+    real :: a(N), x
+    !$omp declare target
+
+    !$omp metadirective &
+    !$omp&  when (construct={target}: distribute parallel do ) &
+    !$omp&  default(parallel do simd)
+      do i = 1, N
+	a(i) = x * i
+      end do
+  end subroutine
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-3.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-3.f90
new file mode 100644
index 00000000000..693c40bca5a
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-3.f90
@@ -0,0 +1,29 @@
+! { dg-do run }
+
+program test
+  implicit none
+
+  integer, parameter :: N = 100
+  integer :: a(N)
+  integer :: res
+
+  if (f (a, .false.)) stop 1
+  if (.not. f (a, .true.)) stop 2
+contains
+  logical function f (a, flag)
+    integer :: a(N)
+    logical :: flag
+    logical :: res = .false.
+    integer :: i
+    f = .false.
+    !$omp metadirective &
+    !$omp&  when (user={condition(.not. flag)}: &
+    !$omp&	 target teams distribute parallel do &
+    !$omp&		map(from: a(1:N)) private(res)) &
+    !$omp&  default(parallel do)
+      do i = 1, N
+	a(i) = i
+	f = .true.
+     end do
+  end function
+end program
diff --git a/libgomp/testsuite/libgomp.fortran/metadirective-4.f90 b/libgomp/testsuite/libgomp.fortran/metadirective-4.f90
new file mode 100644
index 00000000000..04fdf61489c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/metadirective-4.f90
@@ -0,0 +1,46 @@
+! { dg-do run }
+
+program test
+  use omp_lib
+
+  implicit none
+  integer, parameter :: N = 100
+  integer :: a(N)
+  logical :: is_parallel, is_static
+
+  ! is_static is always set if run_parallel is false.
+  call f (a, .false., .false., is_parallel, is_static)
+  if (is_parallel .or. .not. is_static) stop 1
+
+  call f (a, .false., .true., is_parallel, is_static)
+  if (is_parallel .or. .not. is_static) stop 2
+
+  call f (a, .true., .false., is_parallel, is_static)
+  if (.not. is_parallel .or. is_static) stop 3
+
+  call f (a, .true., .true., is_parallel, is_static)
+  if (.not. is_parallel .or. .not. is_static) stop 4
+contains
+  subroutine f (a, run_parallel, run_static, is_parallel, is_static)
+    integer :: a(N)
+    logical, intent(in) :: run_parallel, run_static
+    logical, intent(out) :: is_parallel, is_static
+    integer :: i
+
+    is_parallel = .false.
+    is_static = .false.
+
+    !$omp begin metadirective when(user={condition(run_parallel)}: parallel)
+      if (omp_in_parallel ()) is_parallel = .true.
+
+      !$omp metadirective &
+      !$omp&  when(construct={parallel}, user={condition(.not. run_static)}: &
+      !$omp&       do schedule(guided) private(is_static)) &
+      !$omp&  when(construct={parallel}: do schedule(static))
+	do i = 1, N
+	  a(i) = i
+	  is_static = .true.
+	end do
+    !$omp end metadirective
+  end subroutine
+end program
-- 
2.25.1

Re: [PATCH 7/7] openmp: Add testcases for metadirectives

[Jakub Jelinek]

On Fri, Dec 10, 2021 at 05:40:36PM +0000, Kwok Cheung Yeung wrote:
> This adds testcases for metadirectives.

Let me start with the last patch.

> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-1.c
> @@ -0,0 +1,29 @@
> +/* { dg-do compile } */
> +
> +#define N 100
> +
> +void f (int a[], int b[], int c[])
> +{
> +  #pragma omp metadirective \
> +      default (teams loop) \
> +      default (parallel loop) /* { dg-error "there can only be one default clause in a metadirective before '\\(' token" } */

I'd prefer consistency, check_no_duplicate_clause prints for similar bugs
too many %qs clauses
so it would be nice if this emitted the same (and the before '\\(' token
part would be nice to avoid as well (i.e. use error rather than parse
error).

> --- /dev/null
> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-2.c
> @@ -0,0 +1,74 @@
> +/* { dg-do compile } */
> +
> +#define N 100
> +
> +int main (void)
> +{
> +  int x = 0;
> +  int y = 0;
> +
> +  /* Test implicit default (nothing).  */
> +  #pragma omp metadirective \
> +      when (device={arch("nvptx")}: barrier)
> +    x = 1;

I'm not really sure if device={arch("nvptx")} in main is
the best idea for most of such tests.
Because we should be able to decide that right away, main isn't
declare target to (and better shouldn't be) and so when we know host
isn't nvptx and that it won't be offloaded, it is clear it can't be
that arch.
Of course, we need to test such a case too in a few spots, but it would
be nice to have more diversity in the tests.
One possibility is non-main function with declare target to after the
function definition (but one can't then use teams in the metadirectives).
But would be nice to use more variety in selectors, user, implementation, device
with isa or kind, etc. instead of using always the same thing in most of the
tests.

Also it would be nice to cover say a directive which needs loop, a directive
which needs a normal body and say 2 directives which are standalone.

> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-3.c
> @@ -0,0 +1,31 @@
> +/* { dg-do compile } */
> +/* { dg-additional-options "-fdump-tree-original" } */
> +/* { dg-additional-options "-fdump-tree-gimple" } */
> +/* { dg-additional-options "-fdump-tree-optimized" } */
> +
> +#define N 100
> +
> +void f (int x[], int y[], int z[])
> +{
> +  int i;
> +
> +  #pragma omp target map(to: x, y) map(from: z)
> +    #pragma omp metadirective \
> +	when (device={arch("nvptx")}: teams loop) \
> +	default (parallel loop)

It would be nice to have many of the tests where all the metadirective
variants are actually possible.  Here the nvptx variant
is quite unlikely, nvptx is rarely tested as host arch,
f is not declare target to and even if it was, teams is not allowed
inside of target regions like that.

> --- /dev/null
> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-4.c
> +
> +  /* TODO: This does not execute a version of f with the default clause
> +     active as might be expected.  */

Might be nice to mention that it is correct 5.0 behavior, 5.1 is just
broken in this regard and 5.2 changed the behavior so that parallel loop
is actually invoked.

> +  f (a, 2.71828);

> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-5.c
> @@ -0,0 +1,24 @@
> +/* { dg-do compile } */
> +/* { dg-additional-options "-fdump-tree-original" } */
> +
> +#define N 100
> +
> +void f (int a[], int flag)
> +{
> +  int i;
> +  #pragma omp metadirective \
> +	when (user={condition(flag)}: \
> +		target teams distribute parallel for map(from: a[0:N])) \
> +	default (parallel for)
> +  for (i = 0; i < N; i++)
> +    a[i] = i;
> +}
> +
> +/* The metadirective should be resolved at parse time.  */

???  How can it?  The above is invalid in OpenMP 5.0 (condition
should be constant expression), it is valid in OpenMP 5.1, but is then
resolved at runtime, certainly not at parse time.

Would be nice to also test user={condition(1)} etc. where it would
be resolved at parse time.
And, please add some tests even with user scores.

> +++ b/gcc/testsuite/c-c++-common/gomp/metadirective-6.c
> @@ -0,0 +1,31 @@
> +/* { dg-do compile } */
> +/* { dg-additional-options "-fdump-tree-original" } */
> +/* { dg-additional-options "-fdump-tree-gimple" } */
> +
> +#define N 100
> +
> +void bar (int a[], int run_parallel, int run_guided)
> +{
> +  #pragma omp metadirective \
> +	when (user={condition(run_parallel)}: parallel)
> +  {
> +    int i;
> +    #pragma omp metadirective \
> +	when (construct={parallel}, user={condition(run_guided)}: \
> +	      for schedule(guided)) \
> +	when (construct={parallel}: for schedule(static))
> +      for (i = 0; i < N; i++)
> +	a[i] = i;
> +   }
> + }
> +
> +/* The outer metadirective should be resolved at parse time.  */
> +/* The inner metadirective should be resolved during Gimplificiation.  */

Again, dynamic condition, so I don't see how this holds, both should be
resolved at runtime.

> +++ b/libgomp/testsuite/libgomp.c-c++-common/metadirective-1.c
> @@ -0,0 +1,35 @@
> +/* { dg-do run } */
> +
> +#define N 100
> +
> +void f (int x[], int y[], int z[])
> +{
> +  int i;
> +
> +  #pragma omp target map(to: x[0:N], y[0:N]) map(from: z[0:N])
> +    #pragma omp metadirective \
> +	when (device={arch("nvptx")}: teams loop) \
> +	default (parallel loop)
> +      for (i = 0; i < N; i++)

This doesn't really test which of them was selected and one of them is
extremely unlikely.  Doesn't hurt to have some such tests, but would be
nice if there were tests that it could vary (e.g. same test triggering
both or all variants in different code paths, with selector chosen
such that it is possible) where it would return different results
and at runtime it would be possible to decide which one is which.
That can be done either through declare variant in the body, or say
nested metadirective which will say through data sharing or mapping
result in different values (say task shared(var) in one case and
task firstprivate(var) in another etc.).

	Jakub

[PATCH] openmp: Metadirective patch fixes

[Kwok Cheung Yeung]

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

Hello

This patch fixes a couple of issues with the latest patch series for 
metadirectives.

Firstly, the changes to c_parser_skip_to_end_of_block_or_statement and 
its C++ equivalent cause a couple of tests (e.g. gcc.dg/attr-malloc.c) 
to regress.

This is because these tests cause the parser to skip code starting from 
within a pair of brackets - this causes the unsigned nesting_depth to 
wrap around to UINT_MAX when a ')' is encountered and so semicolons no 
longer stop the skipping, causing too much code to be skipped and 
resulting in the test regressions. This is fixed by tracking the bracket 
nesting level separately from the brace nesting level in a signed int, 
and to allow skipping to end with negative values.

Secondly, user condition selectors containing only compile-time 
constants should be treated as static rather than dynamic. In practice 
though it doesn't matter much, as GCC readily eliminates the resulting 
'if (<const>)' statements via constant folding.

These fixes should be merged into the original metadirective patches.

Thanks

Kwok

[-- Attachment #2: 0008-openmp-Metadirective-fixes.patch --]
[-- Type: text/plain, Size: 4511 bytes --]

From 77f419aef8a608440789b0ebb4a08f11d69f00e2 Mon Sep 17 00:00:00 2001
From: Kwok Cheung Yeung <kcy@codesourcery.com>
Date: Fri, 21 Jan 2022 18:23:57 +0000
Subject: [PATCH 8/9] openmp: Metadirective fixes

Fix regressions introduced by block/statement skipping.

If user condition selector is constant, do not return it as a dynamic
selector.

2022-01-21  Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/c/
	* c-parser.cc (c_parser_skip_to_end_of_block_or_statement): Track
	bracket depth separately from nesting depth.

	gcc/cp/
	* parser.cc (cp_parser_skip_to_end_of_statement): Revert.
	(cp_parser_skip_to_end_of_block_or_statement): Track bracket depth
	separately from nesting depth.

	gcc/
	* omp-general.cc (omp_dynamic_cond): Do not return user condition if
	constant.
---
 gcc/c/c-parser.cc  |  9 ++++++---
 gcc/cp/parser.cc   | 20 ++++++--------------
 gcc/omp-general.cc |  8 ++++++--
 3 files changed, 18 insertions(+), 19 deletions(-)

diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc
index 47075973bfe..f3afc38eb65 100644
--- a/gcc/c/c-parser.cc
+++ b/gcc/c/c-parser.cc
@@ -1344,6 +1344,7 @@ static void
 c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
 {
   unsigned nesting_depth = 0;
+  int bracket_depth = 0;
   bool save_error = parser->error;
 
   while (true)
@@ -1366,7 +1367,7 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
 	case CPP_SEMICOLON:
 	  /* If the next token is a ';', we have reached the
 	     end of the statement.  */
-	  if (!nesting_depth)
+	  if (!nesting_depth && bracket_depth <= 0)
 	    {
 	      /* Consume the ';'.  */
 	      c_parser_consume_token (parser);
@@ -1394,11 +1395,13 @@ c_parser_skip_to_end_of_block_or_statement (c_parser *parser)
 	  /* Track parentheses in case the statement is a standalone 'for'
 	     statement - we want to skip over the semicolons separating the
 	     operands.  */
-	  nesting_depth++;
+	  if (nesting_depth == 0)
+	    ++bracket_depth;
 	  break;
 
 	case CPP_CLOSE_PAREN:
-	  nesting_depth--;
+	  if (nesting_depth == 0)
+	    --bracket_depth;
 	  break;
 
 	case CPP_PRAGMA:
diff --git a/gcc/cp/parser.cc b/gcc/cp/parser.cc
index de35f42d7c4..7cfaff9d65b 100644
--- a/gcc/cp/parser.cc
+++ b/gcc/cp/parser.cc
@@ -3931,17 +3931,6 @@ cp_parser_skip_to_end_of_statement (cp_parser* parser)
 	  ++nesting_depth;
 	  break;
 
-	case CPP_OPEN_PAREN:
-	  /* Track parentheses in case the statement is a standalone 'for'
-	     statement - we want to skip over the semicolons separating the
-	     operands.  */
-	  ++nesting_depth;
-	  break;
-
-	case CPP_CLOSE_PAREN:
-	  --nesting_depth;
-	  break;
-
 	case CPP_KEYWORD:
 	  if (token->keyword != RID__EXPORT
 	      && token->keyword != RID__MODULE
@@ -3991,6 +3980,7 @@ static void
 cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
 {
   int nesting_depth = 0;
+  int bracket_depth = 0;
 
   /* Unwind generic function template scope if necessary.  */
   if (parser->fully_implicit_function_template_p)
@@ -4012,7 +4002,7 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
 
 	case CPP_SEMICOLON:
 	  /* Stop if this is an unnested ';'. */
-	  if (!nesting_depth)
+	  if (!nesting_depth && bracket_depth <= 0)
 	    nesting_depth = -1;
 	  break;
 
@@ -4035,11 +4025,13 @@ cp_parser_skip_to_end_of_block_or_statement (cp_parser* parser)
 	  /* Track parentheses in case the statement is a standalone 'for'
 	     statement - we want to skip over the semicolons separating the
 	     operands.  */
-	  nesting_depth++;
+	  if (nesting_depth == 0)
+	    bracket_depth++;
 	  break;
 
 	case CPP_CLOSE_PAREN:
-	  nesting_depth--;
+	  if (nesting_depth == 0)
+	    bracket_depth--;
 	  break;
 
 	case CPP_KEYWORD:
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 9db729e6d59..bab4a932f5d 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -1990,7 +1990,7 @@ omp_get_context_selector (tree ctx, const char *set, const char *sel)
 }
 
 /* Return a tree expression representing the dynamic part of the context
- * selector CTX.  */
+   selector CTX.  */
 
 static tree
 omp_dynamic_cond (tree ctx)
@@ -2001,8 +2001,12 @@ omp_dynamic_cond (tree ctx)
       tree expr_list = TREE_VALUE (user);
 
       gcc_assert (TREE_PURPOSE (expr_list) == NULL_TREE);
-      return TREE_VALUE (expr_list);
+
+      /* The user condition is not dynamic if it is constant.  */
+      if (!tree_fits_shwi_p (TREE_VALUE (expr_list)))
+	return TREE_VALUE (expr_list);
     }
+
   return NULL_TREE;
 }
 
-- 
2.25.1