diff mbox series

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

Message ID 88facbcc-5be6-5c3b-1e73-f5ceba75ef6f@codesourcery.com
State New
Headers
Series openmp: OpenMP metadirectives support |

Commit Message

Kwok Cheung Yeung Dec. 10, 2021, 5:39 p.m. UTC 
  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
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(-)

Comments

Kwok Cheung Yeung Feb. 14, 2022, 3:09 p.m. UTC | #1 
> 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
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" } }
Kwok Cheung Yeung Feb. 14, 2022, 3:17 p.m. UTC | #2 
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
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
diff mbox series

Patch

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;
     }