Re: [Patch] Fortran: Add OpenMP's assume(s) directives

[Tobias Burnus <tobias@codesourcery.com>]

[-- Attachment #1.1: Type: text/plain, Size: 3416 bytes --]

Minor update to just posted patch: the table did not revert all strings where a substring directive name existed, i.e. 'target' vs. 'target update', 'assume' vs. 'assumes'. Now fixed. Otherwise unchanged:

Tobias

On 05.10.22 13:19, Tobias Burnus wrote:

Hi Jakub,

On 04.10.22 14:58, Jakub Jelinek via Gcc-patches wrote:

On Tue, Oct 04, 2022 at 02:26:13PM +0200, Tobias Burnus wrote:


On Sun, Oct 02, 2022 at 07:47:18PM +0200, Tobias Burnus wrote:
--- a/gcc/doc/invoke.texi
+++ b/gcc/doc/invoke.texi

OK?


Ok, thanks.

Committed as https://gcc.gnu.org/r13-3063-g8792047470073df0da4a5b91997d6058193d7676

Wouldn't this be better table driven (like c_omp_directives
in c-family, though guess for Fortran you can just use spaces
in the name, don't need 3 strings for the separate tokens)?
Because I think absent/contains isn't the only spot where
you need directive names, metadirective is another.

Now added. I noted that I have different kinds/categories than you used in c-family/c-omp.c; and my impression that standalone vs. block vs delimited is a different category than informational/meta/...

Maybe – I think there are already way to many string repetitions. One problem is that metadirectives permit combined/composite constructs while 'assume(s)' does not. I on purpose did not parse them, but probably in light of Metadirectives, I should.

I will take a look.


It is true that metadirective supports combined/composite constructs,
and so do we in the C++ attribute case, still we IMHO can use the C/C++
table as is.and it doesn't need to include combined/composite constructs.

The thing is that for the metadirective/C++ attribute case, all we need to
know is to discover the directive category (declarative, stand-alone,
construct, informational, ...) and for that it is enough to parse the
first directive-name in combined/composite constructs.

...


else if (popcount (old_n_absent) == 1)
   absent = ... sizeof() * (old_n_absent) * 2)


Yeah.  Or for 0 allocate say 8 and
use (pow2p_hwi (old_n_absent) && old_n_absent >= 8)
in the else if.

I used now pow2p_hwi as popcount did not exist (and I didn't want to add an #include or use __builtin_popcount), not that either variant is clearer and it is neither performance critical nor is neither of "(x & -x) == x" and "popcount(x) == 1" slow.

I don't understand the point of preallocation of gfc_omp_clauses here,
...

That's now gone. As I have to check the duplication right after parsing – but before merging, I can no longer do it during resolution. Instead of keeping track of the directives separately, I now moved the checking to the directive parsing itself.

It is not equivalent to that, because while we have the restriction
that the same list item can't appear multiple times on the same directive,
it can appear multiple times on multiple directives.

I am not sure the handling of nested/repeated informational/declarative directives is very clear, but that's a separate issue. (Namely, OpenMP spec issue 3362.)

Updated patch enclosed. And thanks for your comments!

OK?

Tobias

-----------------
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955

[-- Attachment #2: omp-assume-fortran-v2.diff --]
[-- Type: text/x-patch, Size: 41018 bytes --]

Fortran: Add OpenMP's assume(s) directives

libgomp/ChangeLog:

	* libgomp.texi (OpenMP 5.1 Impl. Status): Mark 'assume' as 'Y'.

gcc/fortran/ChangeLog:

	* dump-parse-tree.cc (show_omp_assumes): New.
	(show_omp_clauses, show_namespace): Call it.
	(show_omp_node, show_code_node): Handle OpenMP ASSUME.
	* gfortran.h (enum gfc_statement): Add ST_OMP_ASSUME,
	ST_OMP_END_ASSUME, ST_OMP_ASSUMES and ST_NOTHING.
	(gfc_exec_op): Add EXEC_OMP_ASSUME.
	(gfc_omp_assumptions): New struct.
	(gfc_get_omp_assumptions): New XCNEW #define.
	(gfc_omp_clauses, gfc_namespace): Add assume member.
	(gfc_resolve_omp_assumptions): New prototype.
	* match.h (gfc_match_omp_assume, gfc_match_omp_assumes): New.
	* openmp.cc (omp_code_to_statement): Forward declare.
	(enum gfc_omp_directive_kind, struct gfc_omp_directive): New.
	(gfc_free_omp_clauses): Free assume member and its struct data.
	(enum omp_mask2): Add OMP_CLAUSE_ASSUMPTIONS.
	(gfc_omp_absent_contains_clause): New.
	(gfc_match_omp_clauses): Call it; optionally use passed
	omp_clauses argument.
	(omp_verify_merge_absent_contains, gfc_match_omp_assume,
	 gfc_match_omp_assumes, gfc_resolve_omp_assumptions): New.
	(resolve_omp_clauses): Call the latter.
	(gfc_resolve_omp_directive, omp_code_to_statement): Handle
	EXEC_OMP_ASSUME.
	* parse.cc (decode_omp_directive): Parse OpenMP ASSUME(S).
	(next_statement, parse_executable, parse_omp_structured_block):
	Handle ST_OMP_ASSUME.
	(case_omp_decl): Add ST_OMP_ASSUMES.
	(gfc_ascii_statement): Handle Assumes, optional return
	string without '!$OMP '/'!$ACC ' prefix.
	* parse.h (gfc_ascii_statement): Add optional bool arg to prototype.
	* resolve.cc (gfc_resolve_blocks, gfc_resolve_code): Add
	EXEC_OMP_ASSUME.
	(gfc_resolve): Resolve ASSUMES directive.
	* symbol.cc (gfc_free_namespace): Free omp_assumes member.
	* st.cc (gfc_free_statement): Handle EXEC_OMP_ASSUME.
	* trans-openmp.cc (gfc_trans_omp_directive): Likewise.
	* trans.cc (trans_code): Likewise.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/assume-1.f90: New test.
	* gfortran.dg/gomp/assume-2.f90: New test.
	* gfortran.dg/gomp/assumes-1.f90: New test.
	* gfortran.dg/gomp/assumes-2.f90: New test.

 gcc/fortran/dump-parse-tree.cc               |  41 +++
 gcc/fortran/gfortran.h                       |  23 +-
 gcc/fortran/match.h                          |   2 +
 gcc/fortran/openmp.cc                        | 403 +++++++++++++++++++++++++++
 gcc/fortran/parse.cc                         |  31 ++-
 gcc/fortran/parse.h                          |   2 +-
 gcc/fortran/resolve.cc                       |   5 +
 gcc/fortran/st.cc                            |   1 +
 gcc/fortran/symbol.cc                        |   8 +-
 gcc/fortran/trans-openmp.cc                  |   2 +
 gcc/fortran/trans.cc                         |   1 +
 gcc/testsuite/gfortran.dg/gomp/assume-1.f90  |  24 ++
 gcc/testsuite/gfortran.dg/gomp/assume-2.f90  |  27 ++
 gcc/testsuite/gfortran.dg/gomp/assumes-1.f90 |  82 ++++++
 gcc/testsuite/gfortran.dg/gomp/assumes-2.f90 |  19 ++
 libgomp/libgomp.texi                         |   2 +-
 16 files changed, 665 insertions(+), 8 deletions(-)

diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 40c690c9ae8..2f042ab5142 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -36,6 +36,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "constructor.h"
 #include "version.h"
+#include "parse.h"  /* For gfc_ascii_statement.  */
 
 /* Keep track of indentation for symbol tree dumps.  */
 static int show_level = 0;
@@ -1458,6 +1459,34 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
   gfc_current_ns = ns_curr;
 }
 
+static void
+show_omp_assumes (gfc_omp_assumptions *assume)
+{
+  for (int i = 0; i < assume->n_absent; i++)
+    {
+      fputs (" ABSENT (", dumpfile);
+      fputs (gfc_ascii_statement (assume->absent[i], true), dumpfile);
+      fputc (')', dumpfile);
+    }
+  for (int i = 0; i < assume->n_contains; i++)
+    {
+      fputs (" CONTAINS (", dumpfile);
+      fputs (gfc_ascii_statement (assume->contains[i], true), dumpfile);
+      fputc (')', dumpfile);
+    }
+  for (gfc_expr_list *el = assume->holds; el; el = el->next)
+    {
+      fputs (" HOLDS (", dumpfile);
+      show_expr (el->expr);
+      fputc (')', dumpfile);
+    }
+  if (assume->no_openmp)
+    fputs (" NO_OPENMP", dumpfile);
+  if (assume->no_openmp_routines)
+    fputs (" NO_OPENMP_ROUTINES", dumpfile);
+  if (assume->no_parallelism)
+    fputs (" NO_PARALLELISM", dumpfile);
+}
 
 /* Show OpenMP or OpenACC clauses.  */
 
@@ -1998,6 +2027,8 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
       show_expr (omp_clauses->message);
       fputc (')', dumpfile);
     }
+  if (omp_clauses->assume)
+    show_omp_assumes (omp_clauses->assume);
 }
 
 /* Show a single OpenMP or OpenACC directive node and everything underneath it
@@ -2027,6 +2058,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break;
     case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break;
     case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break;
+    case EXEC_OMP_ASSUME: name = "ASSUME"; break;
     case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
     case EXEC_OMP_BARRIER: name = "BARRIER"; break;
     case EXEC_OMP_CANCEL: name = "CANCEL"; break;
@@ -2128,6 +2160,7 @@ show_omp_node (int level, gfc_code *c)
     case EXEC_OACC_CACHE:
     case EXEC_OACC_ENTER_DATA:
     case EXEC_OACC_EXIT_DATA:
+    case EXEC_OMP_ASSUME:
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_CANCELLATION_POINT:
     case EXEC_OMP_DISTRIBUTE:
@@ -3353,6 +3386,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OACC_CACHE:
     case EXEC_OACC_ENTER_DATA:
     case EXEC_OACC_EXIT_DATA:
+    case EXEC_OMP_ASSUME:
     case EXEC_OMP_ATOMIC:
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_CANCELLATION_POINT:
@@ -3531,6 +3565,13 @@ show_namespace (gfc_namespace *ns)
 	}
     }
 
+  if (ns->omp_assumes)
+    {
+      show_indent ();
+      fprintf (dumpfile, "!$OMP ASSUMES");
+      show_omp_assumes (ns->omp_assumes);
+    }
+
   fputc ('\n', dumpfile);
   show_indent ();
   fputs ("code:", dumpfile);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 4babd77924b..608dda4bf55 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -316,7 +316,9 @@ 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_ERROR, ST_NONE
+  ST_OMP_ERROR, ST_OMP_ASSUME, ST_OMP_END_ASSUME, ST_OMP_ASSUMES,
+  /* Note: gfc_match_omp_nothing returns ST_NONE. */
+  ST_OMP_NOTHING, ST_NONE
 };
 
 /* Types of interfaces that we can have.  Assignment interfaces are
@@ -1506,6 +1508,18 @@ enum gfc_omp_bind_type
   OMP_BIND_THREAD
 };
 
+typedef struct gfc_omp_assumptions
+{
+  int n_absent, n_contains;
+  enum gfc_statement *absent, *contains;
+  gfc_expr_list *holds;
+  bool no_openmp:1, no_openmp_routines:1, no_parallelism:1;
+}
+gfc_omp_assumptions;
+
+#define gfc_get_omp_assumptions() XCNEW (gfc_omp_assumptions)
+
+
 typedef struct gfc_omp_clauses
 {
   gfc_omp_namelist *lists[OMP_LIST_NUM];
@@ -1529,6 +1543,7 @@ typedef struct gfc_omp_clauses
   struct gfc_expr *if_exprs[OMP_IF_LAST];
   struct gfc_expr *dist_chunk_size;
   struct gfc_expr *message;
+  struct gfc_omp_assumptions *assume;
   const char *critical_name;
   enum gfc_omp_default_sharing default_sharing;
   enum gfc_omp_atomic_op atomic_op;
@@ -2145,6 +2160,9 @@ typedef struct gfc_namespace
   /* Linked list of !$omp declare variant constructs.  */
   struct gfc_omp_declare_variant *omp_declare_variant;
 
+  /* OpenMP assumptions.  */
+  struct gfc_omp_assumptions *omp_assumes;
+
   /* A hash set for the gfc expressions that have already
      been finalized in this namespace.  */
 
@@ -2913,7 +2931,7 @@ enum gfc_exec_op
   EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
   EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
   EXEC_OMP_SECTIONS, EXEC_OMP_SINGLE, EXEC_OMP_WORKSHARE,
-  EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
+  EXEC_OMP_ASSUME, EXEC_OMP_ATOMIC, EXEC_OMP_BARRIER, EXEC_OMP_END_NOWAIT,
   EXEC_OMP_END_SINGLE, EXEC_OMP_TASK, EXEC_OMP_TASKWAIT,
   EXEC_OMP_TASKYIELD, EXEC_OMP_CANCEL, EXEC_OMP_CANCELLATION_POINT,
   EXEC_OMP_TASKGROUP, EXEC_OMP_SIMD, EXEC_OMP_DO_SIMD,
@@ -3576,6 +3594,7 @@ 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 *);
 gfc_omp_udr *gfc_omp_udr_find (gfc_symtree *, gfc_typespec *);
+void gfc_resolve_omp_assumptions (gfc_omp_assumptions *);
 void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
 void gfc_resolve_do_iterator (gfc_code *, gfc_symbol *, bool);
 void gfc_resolve_omp_local_vars (gfc_namespace *);
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 1f53e0cb67d..2a805815d9c 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -149,6 +149,8 @@ match gfc_match_oacc_routine (void);
 
 /* OpenMP directive matchers.  */
 match gfc_match_omp_eos_error (void);
+match gfc_match_omp_assume (void);
+match gfc_match_omp_assumes (void);
 match gfc_match_omp_atomic (void);
 match gfc_match_omp_barrier (void);
 match gfc_match_omp_cancel (void);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index ce719bd5d92..f586460b61a 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -29,6 +29,86 @@ along with GCC; see the file COPYING3.  If not see
 #include "diagnostic.h"
 #include "gomp-constants.h"
 #include "target-memory.h"  /* For gfc_encode_character.  */
+#include "bitmap.h"
+
+
+static gfc_statement omp_code_to_statement (gfc_code *);
+
+enum gfc_omp_directive_kind {
+  GFC_OMP_DIR_DECLARATIVE,
+  GFC_OMP_DIR_EXECUTABLE,
+  GFC_OMP_DIR_INFORMATIONAL,
+  GFC_OMP_DIR_META,
+  GFC_OMP_DIR_SUBSIDIARY,
+  GFC_OMP_DIR_UTILITY
+};
+
+struct gfc_omp_directive {
+  const char *name;
+  enum gfc_omp_directive_kind kind;
+  gfc_statement st;
+};
+
+/* Alphabetically sorted OpenMP clauses, except that longer strings are before
+   substrings; excludes combined/composite directives. See note for "ordered"
+   and "nothing".  */
+
+static const struct gfc_omp_directive gfc_omp_directives[] = {
+  /* {"allocate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_ALLOCATE}, */
+  /* {"allocators", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ALLOCATORS}, */
+  {"assumes", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_ASSUMES},
+  {"assume", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_ASSUME},
+  {"atomic", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ATOMIC},
+  {"barrier", GFC_OMP_DIR_EXECUTABLE, ST_OMP_BARRIER},
+  {"cancellation point", GFC_OMP_DIR_EXECUTABLE, ST_OMP_CANCELLATION_POINT},
+  {"cancel", GFC_OMP_DIR_EXECUTABLE, ST_OMP_CANCEL},
+  {"critical", GFC_OMP_DIR_EXECUTABLE, ST_OMP_CRITICAL},
+  /* {"declare mapper", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_MAPPER}, */
+  {"declare reduction", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_REDUCTION},
+  {"declare simd", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_SIMD},
+  {"declare target", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_TARGET},
+  {"declare variant", GFC_OMP_DIR_DECLARATIVE, ST_OMP_DECLARE_VARIANT},
+  {"depobj", GFC_OMP_DIR_EXECUTABLE, ST_OMP_DEPOBJ},
+  /* {"dispatch", GFC_OMP_DIR_EXECUTABLE, ST_OMP_DISPATCH}, */
+  {"distribute", GFC_OMP_DIR_EXECUTABLE, ST_OMP_DISTRIBUTE},
+  {"do", GFC_OMP_DIR_EXECUTABLE, ST_OMP_DO},
+  /* "error" becomes GFC_OMP_DIR_EXECUTABLE with at(execution) */
+  {"error", GFC_OMP_DIR_UTILITY, ST_OMP_ERROR},
+  {"flush", GFC_OMP_DIR_EXECUTABLE, ST_OMP_FLUSH},
+  /* {"interop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_INTEROP}, */
+  {"loop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_LOOP},
+  {"masked", GFC_OMP_DIR_EXECUTABLE, ST_OMP_MASKED},
+  /* {"metadirective", GFC_OMP_DIR_META, ST_OMP_METADIRECTIVE}, */
+  /* Note: gfc_match_omp_nothing returns ST_NONE.  */
+  {"nothing", GFC_OMP_DIR_UTILITY, ST_OMP_NOTHING},
+  /* Special case; for now map to the first one.
+     ordered-blockassoc = ST_OMP_ORDERED
+     ordered-standalone = ST_OMP_ORDERED_DEPEND + depend/doacross.  */
+  {"ordered", GFC_OMP_DIR_EXECUTABLE, ST_OMP_ORDERED},
+  {"parallel", GFC_OMP_DIR_EXECUTABLE, ST_OMP_PARALLEL},
+  {"requires", GFC_OMP_DIR_INFORMATIONAL, ST_OMP_REQUIRES},
+  {"scan", GFC_OMP_DIR_SUBSIDIARY, ST_OMP_SCAN},
+  {"scope", GFC_OMP_DIR_EXECUTABLE, ST_OMP_SCOPE},
+  {"sections", GFC_OMP_DIR_EXECUTABLE, ST_OMP_SECTIONS},
+  {"section", GFC_OMP_DIR_SUBSIDIARY, ST_OMP_SECTION},
+  {"simd", GFC_OMP_DIR_EXECUTABLE, ST_OMP_SIMD},
+  {"single", GFC_OMP_DIR_EXECUTABLE, ST_OMP_SINGLE},
+  {"target data", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET_DATA},
+  {"target enter data", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET_ENTER_DATA},
+  {"target exit data", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET_EXIT_DATA},
+  {"target update", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET_UPDATE},
+  {"target", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TARGET},
+  {"taskloop", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TASKLOOP},
+  {"taskwait", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TASKWAIT},
+  {"taskyield", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TASKYIELD},
+  {"task", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TASK},
+  {"teams", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TEAMS},
+  {"threadprivate", GFC_OMP_DIR_DECLARATIVE, ST_OMP_THREADPRIVATE},
+  /* {"tile", GFC_OMP_DIR_EXECUTABLE, ST_OMP_TILE}, */
+  /* {"unroll", GFC_OMP_DIR_EXECUTABLE, ST_OMP_UNROLL}, */
+  {"workshare", GFC_OMP_DIR_EXECUTABLE, ST_OMP_WORKSHARE},
+};
+
 
 /* Match an end of OpenMP directive.  End of OpenMP directive is optional
    whitespace, followed by '\n' or comment '!'.  */
@@ -111,6 +191,13 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
   gfc_free_expr_list (c->wait_list);
   gfc_free_expr_list (c->tile_list);
   free (CONST_CAST (char *, c->critical_name));
+  if (c->assume)
+    {
+      free (c->assume->absent);
+      free (c->assume->contains);
+      gfc_free_expr_list (c->assume->holds);
+      free (c->assume);
+    }
   free (c);
 }
 
@@ -992,6 +1079,7 @@ enum omp_mask2
   OMP_CLAUSE_HAS_DEVICE_ADDR,  /* OpenMP 5.1  */
   OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
   OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
+  OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */
   /* This must come last.  */
   OMP_MASK2_LAST
 };
@@ -1407,6 +1495,173 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
   return MATCH_YES;
 }
 
+static match
+gfc_omp_absent_contains_clause (gfc_omp_assumptions **assume, bool is_absent)
+{
+  if (*assume == NULL)
+    *assume = gfc_get_omp_assumptions ();
+  do
+    {
+      gfc_statement st = ST_NONE;
+      gfc_gobble_whitespace ();
+      locus old_loc = gfc_current_locus;
+      char c = gfc_peek_ascii_char ();
+      enum gfc_omp_directive_kind kind
+	= GFC_OMP_DIR_DECLARATIVE; /* Silence warning. */
+      for (size_t i = 0; i < ARRAY_SIZE (gfc_omp_directives); i++)
+	{
+	  if (gfc_omp_directives[i].name[0] > c)
+	    break;
+	  if (gfc_omp_directives[i].name[0] != c)
+	    continue;
+	  if (gfc_match (gfc_omp_directives[i].name) == MATCH_YES)
+	    {
+	      st = gfc_omp_directives[i].st;
+	      kind = gfc_omp_directives[i].kind;
+	    }
+	}
+      gfc_gobble_whitespace ();
+      c = gfc_peek_ascii_char ();
+      if (st == ST_NONE || (c != ',' && c != ')'))
+	{
+	  if (st == ST_NONE)
+	    gfc_error ("Unknown directive at %L", &old_loc);
+	  else
+	    gfc_error ("Invalid combined or composit directive at %L",
+		       &old_loc);
+	  return MATCH_ERROR;
+	}
+      if (kind == GFC_OMP_DIR_DECLARATIVE
+	  || kind == GFC_OMP_DIR_INFORMATIONAL
+	  || kind == GFC_OMP_DIR_META)
+	{
+	  gfc_error ("Invalid %qs directive at %L in %s clause: declarative, "
+		     "informational and meta directives not permitted",
+		     gfc_ascii_statement (st, true), &old_loc,
+		     is_absent ? "ABSENT" : "CONTAINS");
+	  return MATCH_ERROR;
+	}
+      if (is_absent)
+	{
+	  /* Use exponential allocation; equivalent to pow2p(x). */
+	  int i = (*assume)->n_absent;
+	  int size = ((i == 0) ? 4
+		      : pow2p_hwi (i) == 1 ? i*2 : 0);
+	  if (size != 0)
+	    (*assume)->absent = XRESIZEVEC (gfc_statement,
+					    (*assume)->absent, size);
+	  (*assume)->absent[(*assume)->n_absent++] = st;
+	}
+      else
+	{
+	  int i = (*assume)->n_contains;
+	  int size = ((i == 0) ? 4
+		      : pow2p_hwi (i) == 1 ? i*2 : 0);
+	  if (size != 0)
+	    (*assume)->contains = XRESIZEVEC (gfc_statement,
+					      (*assume)->contains, size);
+	  (*assume)->contains[(*assume)->n_contains++] = st;
+	}
+      gfc_gobble_whitespace ();
+      if (gfc_match(",") == MATCH_YES)
+	continue;
+      if (gfc_match(")") == MATCH_YES)
+	break;
+      gfc_error ("Expected %<,%> or %<)%> at %C");
+      return MATCH_ERROR;
+    }
+  while (true);
+
+  return MATCH_YES;
+}
+
+/* Check 'check' argument for duplicated statements in absent and/or contains
+   clauses. If 'merge', merge them from check to 'merge'.  */
+
+static match
+omp_verify_merge_absent_contains (gfc_statement st, gfc_omp_assumptions *check,
+				  gfc_omp_assumptions *merge, locus *loc)
+{
+  if (check == NULL)
+    return MATCH_YES;
+  bitmap_head absent_head, contains_head;
+  bitmap_obstack_initialize (NULL);
+  bitmap_initialize (&absent_head, &bitmap_default_obstack);
+  bitmap_initialize (&contains_head, &bitmap_default_obstack);
+
+  match m = MATCH_YES;
+  for (int i = 0; i < check->n_absent; i++)
+    if (!bitmap_set_bit (&absent_head, check->absent[i]))
+      {
+	gfc_error ("%qs directive mentioned multiple times in %s clause in %s "
+		   "directive at %L",
+		   gfc_ascii_statement (check->absent[i], true),
+		   "ABSENT", gfc_ascii_statement (st), loc);
+	m = MATCH_ERROR;
+      }
+  for (int i = 0; i < check->n_contains; i++)
+    {
+      if (!bitmap_set_bit (&contains_head, check->contains[i]))
+	{
+	  gfc_error ("%qs directive mentioned multiple times in %s clause in %s "
+		     "directive at %L",
+		     gfc_ascii_statement (check->contains[i], true),
+		     "CONTAINS", gfc_ascii_statement (st), loc);
+	  m = MATCH_ERROR;
+	}
+      if (bitmap_bit_p (&absent_head, check->contains[i]))
+	{
+	  gfc_error ("%qs directive mentioned both times in ABSENT and CONTAINS "
+		     "clauses in %s directive at %L",
+		     gfc_ascii_statement (check->absent[i], true),
+		     gfc_ascii_statement (st), loc);
+	  m = MATCH_ERROR;
+	}
+    }
+
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+  if (merge == NULL)
+    return MATCH_YES;
+  if (merge->absent == NULL && check->absent)
+    {
+      merge->n_absent = check->n_absent;
+      merge->absent = check->absent;
+      check->absent = NULL;
+    }
+  else if (merge->absent && check->absent)
+    {
+      check->absent = XRESIZEVEC (gfc_statement, check->absent,
+				  merge->n_absent + check->n_absent);
+      for (int i = 0; i < merge->n_absent; i++)
+	if (!bitmap_bit_p (&absent_head, merge->absent[i]))
+	  check->absent[check->n_absent++] = merge->absent[i];
+      free (merge->absent);
+      merge->absent = check->absent;
+      merge->n_absent = check->n_absent;
+      check->absent = NULL;
+    }
+  if (merge->contains == NULL && check->contains)
+    {
+      merge->n_contains = check->n_contains;
+      merge->contains = check->contains;
+      check->contains = NULL;
+    }
+  else if (merge->contains && check->contains)
+    {
+      check->contains = XRESIZEVEC (gfc_statement, check->contains,
+				    merge->n_contains + check->n_contains);
+      for (int i = 0; i < merge->n_contains; i++)
+	if (!bitmap_bit_p (&contains_head, merge->contains[i]))
+	  check->contains[check->n_contains++] = merge->contains[i];
+      free (merge->contains);
+      merge->contains = check->contains;
+      merge->n_contains = check->n_contains;
+      check->contains = NULL;
+    }
+  return MATCH_YES;
+}
+
 
 /* Match with duplicate check. Matches 'name'. If expr != NULL, it
    then matches '(expr)', otherwise, if open_parens is true,
@@ -1511,6 +1766,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	case 'a':
 	  end_colon = false;
 	  head = NULL;
+	  if ((mask & OMP_CLAUSE_ASSUMPTIONS)
+	      && gfc_match ("absent ( ") == MATCH_YES)
+	    {
+	      if (gfc_omp_absent_contains_clause (&c->assume, true)
+		  != MATCH_YES)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_ALIGNED)
 	      && gfc_match_omp_variable_list ("aligned (",
 					      &c->lists[OMP_LIST_ALIGNED],
@@ -1743,6 +2006,14 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 	      needs_space = true;
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_ASSUMPTIONS)
+	      && gfc_match ("contains ( ") == MATCH_YES)
+	    {
+	      if (gfc_omp_absent_contains_clause (&c->assume, false)
+		  != MATCH_YES)
+		goto error;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_COPY)
 	      && gfc_match ("copy ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -2277,6 +2548,20 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 		goto error;
 	      continue;
 	    }
+	  if ((mask & OMP_CLAUSE_ASSUMPTIONS)
+	      && gfc_match ("holds ( ") == MATCH_YES)
+	    {
+	      gfc_expr *e;
+	      if (gfc_match ("%e )", &e) != MATCH_YES)
+		goto error;
+	      if (c->assume == NULL)
+		c->assume = gfc_get_omp_assumptions ();
+	      gfc_expr_list *el = XCNEW (gfc_expr_list);
+	      el->expr = e;
+	      el->next = c->assume->holds;
+	      c->assume->holds = el;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_HOST_SELF)
 	      && gfc_match ("host ( ") == MATCH_YES
 	      && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -2664,6 +2949,41 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
 					   OMP_MAP_IF_PRESENT, true,
 					   allow_derived))
 	    continue;
+	  if ((mask & OMP_CLAUSE_ASSUMPTIONS)
+	      && (m = gfc_match_dupl_check (!c->assume
+					    || !c->assume->no_openmp_routines,
+					    "no_openmp_routines")) == MATCH_YES)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (c->assume == NULL)
+		c->assume = gfc_get_omp_assumptions ();
+	      c->assume->no_openmp_routines = needs_space = true;
+	      continue;
+	    }
+	  if ((mask & OMP_CLAUSE_ASSUMPTIONS)
+	      && (m = gfc_match_dupl_check (!c->assume || !c->assume->no_openmp,
+					    "no_openmp")) == MATCH_YES)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (c->assume == NULL)
+		c->assume = gfc_get_omp_assumptions ();
+	      c->assume->no_openmp = needs_space = true;
+	      continue;
+	    }
+	  if ((mask & OMP_CLAUSE_ASSUMPTIONS)
+	      && (m = gfc_match_dupl_check (!c->assume
+					    || !c->assume->no_parallelism,
+					    "no_parallelism")) == MATCH_YES)
+	    {
+	      if (m == MATCH_ERROR)
+		goto error;
+	      if (c->assume == NULL)
+		c->assume = gfc_get_omp_assumptions ();
+	      c->assume->no_parallelism = needs_space = true;
+	      continue;
+	    }
 	  if ((mask & OMP_CLAUSE_NOGROUP)
 	      && (m = gfc_match_dupl_check (!c->nogroup, "nogroup"))
 		 != MATCH_NO)
@@ -3941,6 +4261,69 @@ match_omp (gfc_exec_op op, const omp_mask mask)
 }
 
 
+match
+gfc_match_omp_assume (void)
+{
+  gfc_omp_clauses *c;
+  locus loc = gfc_current_locus;
+  if ((gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS))
+       != MATCH_YES)
+      || (omp_verify_merge_absent_contains (ST_OMP_ASSUME, c->assume, NULL,
+					    &loc) != MATCH_YES))
+    return MATCH_ERROR;
+  new_st.op = EXEC_OMP_ASSUME;
+  new_st.ext.omp_clauses = c;
+  return MATCH_YES;
+}
+
+
+match
+gfc_match_omp_assumes (void)
+{
+  gfc_omp_clauses *c;
+  locus loc = gfc_current_locus;
+  if (!gfc_current_ns->proc_name
+      || (gfc_current_ns->proc_name->attr.flavor != FL_MODULE
+	  && !gfc_current_ns->proc_name->attr.subroutine
+	  && !gfc_current_ns->proc_name->attr.function))
+    {
+      gfc_error ("!OMP ASSUMES at %C must be in the specification part of a "
+		 "subprogram or module");
+      return MATCH_ERROR;
+    }
+  if ((gfc_match_omp_clauses (&c, omp_mask (OMP_CLAUSE_ASSUMPTIONS))
+       != MATCH_YES)
+      || (omp_verify_merge_absent_contains (ST_OMP_ASSUMES, c->assume,
+					    gfc_current_ns->omp_assumes, &loc)
+	  != MATCH_YES))
+    return MATCH_ERROR;
+  if (gfc_current_ns->omp_assumes == NULL)
+    {
+      gfc_current_ns->omp_assumes = c->assume;
+      c->assume = NULL;
+    }
+  else if (gfc_current_ns->omp_assumes && c->assume)
+    {
+      gfc_current_ns->omp_assumes->no_openmp |= c->assume->no_openmp;
+      gfc_current_ns->omp_assumes->no_openmp_routines
+	|= c->assume->no_openmp_routines;
+      gfc_current_ns->omp_assumes->no_parallelism |= c->assume->no_parallelism;
+      if (gfc_current_ns->omp_assumes->holds && c->assume->holds)
+	{
+	  gfc_expr_list *el = gfc_current_ns->omp_assumes->holds;
+	  for ( ; el->next ; el = el->next)
+	    ;
+	  el->next = c->assume->holds;
+	}
+      else if (c->assume->holds)
+	gfc_current_ns->omp_assumes->holds = c->assume->holds;
+      c->assume->holds = NULL;
+    }
+  gfc_free_omp_clauses (c);
+  return MATCH_YES;
+}
+
+
 match
 gfc_match_omp_critical (void)
 {
@@ -6505,6 +6888,20 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
   return copy;
 }
 
+
+/* Resolve ASSUME's and ASSUMES' assumption clauses.  Note that absent/contains
+   is handled during parse time in omp_verify_merge_absent_contains.   */
+
+void
+gfc_resolve_omp_assumptions (gfc_omp_assumptions *assume)
+{
+  for (gfc_expr_list *el = assume->holds; el; el = el->next)
+    if (!gfc_resolve_expr (el->expr) || el->expr->ts.type != BT_LOGICAL)
+	gfc_error ("HOLDS expression at %L must be a logical expression",
+		   &el->expr->where);
+}
+
+
 /* OpenMP directive resolving routines.  */
 
 static void
@@ -7888,6 +8285,9 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
 	gfc_error ("%<DETACH%> clause at %L must not be used together with "
 		   "%<MERGEABLE%> clause", &omp_clauses->detach->where);
     }
+
+  if (omp_clauses->assume)
+    gfc_resolve_omp_assumptions (omp_clauses->assume);
 }
 
 
@@ -9116,6 +9516,8 @@ omp_code_to_statement (gfc_code *code)
       return ST_OMP_DO;
     case EXEC_OMP_LOOP:
       return ST_OMP_LOOP;
+    case EXEC_OMP_ASSUME:
+      return ST_OMP_ASSUME;
     case EXEC_OMP_ATOMIC:
       return ST_OMP_ATOMIC;
     case EXEC_OMP_BARRIER:
@@ -9635,6 +10037,7 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
     case EXEC_OMP_TEAMS_LOOP:
       resolve_omp_do (code);
       break;
+    case EXEC_OMP_ASSUME:
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_ERROR:
     case EXEC_OMP_MASKED:
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 2e2e9770520..f04fd13cc69 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -885,6 +885,8 @@ decode_omp_directive (void)
   switch (c)
     {
     case 'a':
+      matcho ("assumes", gfc_match_omp_assumes, ST_OMP_ASSUMES);
+      matchs ("assume", gfc_match_omp_assume, ST_OMP_ASSUME);
       matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
       break;
     case 'b':
@@ -913,6 +915,7 @@ decode_omp_directive (void)
       break;
     case 'e':
       matcho ("error", gfc_match_omp_error, ST_OMP_ERROR);
+      matchs ("end assume", gfc_match_omp_eos_error, ST_OMP_END_ASSUME);
       matcho ("end atomic", gfc_match_omp_eos_error, ST_OMP_END_ATOMIC);
       matcho ("end critical", gfc_match_omp_end_critical, ST_OMP_END_CRITICAL);
       matchs ("end distribute parallel do simd", gfc_match_omp_eos_error,
@@ -1716,6 +1719,7 @@ next_statement (void)
   case ST_OMP_TARGET_SIMD: case ST_OMP_TASKLOOP: case ST_OMP_TASKLOOP_SIMD: \
   case ST_OMP_LOOP: case ST_OMP_PARALLEL_LOOP: case ST_OMP_TEAMS_LOOP: \
   case ST_OMP_TARGET_PARALLEL_LOOP: case ST_OMP_TARGET_TEAMS_LOOP: \
+  case ST_OMP_ASSUME: \
   case ST_CRITICAL: \
   case ST_OACC_PARALLEL_LOOP: case ST_OACC_PARALLEL: case ST_OACC_KERNELS: \
   case ST_OACC_DATA: case ST_OACC_HOST_DATA: case ST_OACC_LOOP: \
@@ -1733,7 +1737,7 @@ next_statement (void)
 
 #define case_omp_decl case ST_OMP_THREADPRIVATE: case ST_OMP_DECLARE_SIMD: \
   case ST_OMP_DECLARE_TARGET: case ST_OMP_DECLARE_REDUCTION: \
-  case ST_OMP_DECLARE_VARIANT: \
+  case ST_OMP_DECLARE_VARIANT: case ST_OMP_ASSUMES: \
   case ST_OMP_REQUIRES: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
 
 /* Block end statements.  Errors associated with interchanging these
@@ -1925,10 +1929,11 @@ gfc_enclosing_unit (gfc_compile_state * result)
 }
 
 
-/* Translate a statement enum to a string.  */
+/* Translate a statement enum to a string.  If strip_sentinel is true,
+   the !$OMP/!$ACC sentinel is excluded.  */
 
 const char *
-gfc_ascii_statement (gfc_statement st)
+gfc_ascii_statement (gfc_statement st, bool strip_sentinel)
 {
   const char *p;
 
@@ -2353,6 +2358,12 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OACC_END_ATOMIC:
       p = "!$ACC END ATOMIC";
       break;
+    case ST_OMP_ASSUME:
+      p = "!$OMP ASSUME";
+      break;
+    case ST_OMP_ASSUMES:
+      p = "!$OMP ASSUMES";
+      break;
     case ST_OMP_ATOMIC:
       p = "!$OMP ATOMIC";
       break;
@@ -2401,6 +2412,9 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_DO_SIMD:
       p = "!$OMP DO SIMD";
       break;
+    case ST_OMP_END_ASSUME:
+      p = "!$OMP END ASSUME";
+      break;
     case ST_OMP_END_ATOMIC:
       p = "!$OMP END ATOMIC";
       break;
@@ -2600,6 +2614,10 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_ORDERED_DEPEND:
       p = "!$OMP ORDERED";
       break;
+    case ST_OMP_NOTHING:
+      /* Note: gfc_match_omp_nothing returns ST_NONE. */
+      p = "!$OMP NOTHING";
+      break;
     case ST_OMP_PARALLEL:
       p = "!$OMP PARALLEL";
       break;
@@ -2751,6 +2769,8 @@ gfc_ascii_statement (gfc_statement st)
       gfc_internal_error ("gfc_ascii_statement(): Bad statement code");
     }
 
+  if (strip_sentinel && p[0] == '!')
+    return p + strlen ("!$OMP ");
   return p;
 }
 
@@ -5518,6 +5538,9 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 
   switch (omp_st)
     {
+    case ST_OMP_ASSUME:
+      omp_end_st = ST_OMP_END_ASSUME;
+      break;
     case ST_OMP_PARALLEL:
       omp_end_st = ST_OMP_END_PARALLEL;
       break;
@@ -5651,6 +5674,7 @@ parse_omp_structured_block (gfc_statement omp_st, bool workshare_stmts_only)
 		  parse_forall_block ();
 		  break;
 
+		case ST_OMP_ASSUME:
 		case ST_OMP_PARALLEL:
 		case ST_OMP_PARALLEL_MASKED:
 		case ST_OMP_PARALLEL_MASTER:
@@ -5874,6 +5898,7 @@ parse_executable (gfc_statement st)
 	  parse_oacc_structured_block (st);
 	  break;
 
+	case ST_OMP_ASSUME:
 	case ST_OMP_PARALLEL:
 	case ST_OMP_PARALLEL_MASKED:
 	case ST_OMP_PARALLEL_MASTER:
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index 7ddea10237f..013aeaedc03 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -66,7 +66,7 @@ extern gfc_state_data *gfc_state_stack;
 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);
+const char *gfc_ascii_statement (gfc_statement, bool strip_sentinel = false) ;
 match gfc_match_enum (void);
 match gfc_match_enumerator_def (void);
 void gfc_free_enum_history (void);
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index ae7ebb624e4..d133bc2d034 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10902,6 +10902,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	case EXEC_OACC_ENTER_DATA:
 	case EXEC_OACC_EXIT_DATA:
 	case EXEC_OACC_ROUTINE:
+	case EXEC_OMP_ASSUME:
 	case EXEC_OMP_CRITICAL:
 	case EXEC_OMP_DISTRIBUTE:
 	case EXEC_OMP_DISTRIBUTE_PARALLEL_DO:
@@ -12376,6 +12377,7 @@ start:
 	  gfc_resolve_oacc_directive (code, ns);
 	  break;
 
+	case EXEC_OMP_ASSUME:
 	case EXEC_OMP_ATOMIC:
 	case EXEC_OMP_BARRIER:
 	case EXEC_OMP_CANCEL:
@@ -17651,6 +17653,9 @@ gfc_resolve (gfc_namespace *ns)
   component_assignment_level = 0;
   resolve_codes (ns);
 
+  if (ns->omp_assumes)
+    gfc_resolve_omp_assumptions (ns->omp_assumes);
+
   gfc_current_ns = old_ns;
   cs_base = old_cs_base;
   ns->resolved = 1;
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index 73f30c2137f..3c8ca66554d 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -214,6 +214,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OACC_ENTER_DATA:
     case EXEC_OACC_EXIT_DATA:
     case EXEC_OACC_ROUTINE:
+    case EXEC_OMP_ASSUME:
     case EXEC_OMP_ATOMIC:
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_CANCELLATION_POINT:
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 7a80dfd063b..6050359d521 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -4071,7 +4071,13 @@ gfc_free_namespace (gfc_namespace *&ns)
       f = f->next;
       free (current);
     }
-
+  if (ns->omp_assumes)
+    {
+      free (ns->omp_assumes->absent);
+      free (ns->omp_assumes->contains);
+      gfc_free_expr_list (ns->omp_assumes->holds);
+      free (ns->omp_assumes);
+    }
   p = ns->contained;
   free (ns);
   ns = NULL;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index 8e9d5346b05..21053694f81 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -7487,6 +7487,8 @@ gfc_trans_omp_directive (gfc_code *code)
 {
   switch (code->op)
     {
+    case EXEC_OMP_ASSUME:
+      return gfc_trans_omp_code (code->block->next, true);
     case EXEC_OMP_ATOMIC:
       return gfc_trans_omp_atomic (code);
     case EXEC_OMP_BARRIER:
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 912a206f2ed..8a64882ea9e 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2174,6 +2174,7 @@ trans_code (gfc_code * code, tree cond)
 	  res = gfc_trans_dt_end (code);
 	  break;
 
+	case EXEC_OMP_ASSUME:
 	case EXEC_OMP_ATOMIC:
 	case EXEC_OMP_BARRIER:
 	case EXEC_OMP_CANCEL:
diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-1.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-1.f90
new file mode 100644
index 00000000000..8bd5c723051
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/assume-1.f90
@@ -0,0 +1,24 @@
+subroutine foo (i, a)
+  implicit none
+  integer, value :: i
+  integer :: a(:)
+  integer :: j
+
+  j = 7
+  !$omp assume no_openmp, absent (target, teams) holds (i < 32) holds (i < 32_2)
+  !$omp end assume
+
+  !$omp assume no_openmp_routines, contains (simd)
+  block
+    !$omp simd
+    do j = 1, i
+      a(i) = j
+    end do
+  end block
+
+  !$omp assume no_parallelism, contains (error)
+  if (i >= 32) then
+    !$omp error at (execution) message ("Should not happen")
+  end if
+  !$omp end assume
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/assume-2.f90 b/gcc/testsuite/gfortran.dg/gomp/assume-2.f90
new file mode 100644
index 00000000000..ca3e04dfe95
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/assume-2.f90
@@ -0,0 +1,27 @@
+subroutine foo (i, a)
+  implicit none
+  integer, value :: i
+  integer :: a(:)
+  integer :: j
+
+  j = 7
+  !$omp assume no_openmp, absent (target, teams,target) holds (i < 32) holds (i < 32_2)  ! { dg-error "'TARGET' directive mentioned multiple times in ABSENT clause in !.OMP ASSUME directive" }
+!  !$omp end assume  - silence: 'Unexpected !$OMP END ASSUME statement'
+
+  !$omp assume no_openmp_routines, contains (simd) contains ( simd )  ! { dg-error "'SIMD' directive mentioned multiple times in CONTAINS clause in !.OMP ASSUME directive" }
+  block
+    !$omp simd
+    do j = 1, i
+      a(i) = j
+    end do
+  end block
+
+  !$omp assume no_parallelism, contains (error) absent (error)  ! { dg-error "'ERROR' directive mentioned both times in ABSENT and CONTAINS clauses in !.OMP ASSUME directive" }
+  if (i >= 32) then
+    !$omp error at (execution) message ("Should not happen")
+  end if
+!  !$omp end assume  - silence: 'Unexpected !$OMP END ASSUME statement'
+
+  !$omp assume holds (1.0)  ! { dg-error "HOLDS expression at .1. must be a logical expression" }
+  !$omp end assume
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/assumes-1.f90 b/gcc/testsuite/gfortran.dg/gomp/assumes-1.f90
new file mode 100644
index 00000000000..3d468dc1c81
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/assumes-1.f90
@@ -0,0 +1,82 @@
+! All of the following (up to PROGRAM) are okay:
+!
+subroutine sub
+  interface
+    subroutine sub_iterface()
+      !$omp assumes no_openmp_routines absent(simd) !  OK inferface of an external subroutine/subprogram
+    end
+  end interface
+  !$omp assumes no_openmp_routines absent(simd) !  OK external subroutine/subprogram
+contains
+  subroutine inner_sub
+     !$omp assumes no_parallelism absent(teams) ! OK internal subroutine/subprogram
+  end
+end
+
+integer function func ()
+  !$omp assumes no_openmp_routines absent(simd) !  OK external function/subprogram
+  interface
+    integer function func_iterface()
+      !$omp assumes no_openmp_routines absent(simd) !  OK inferface of an external function/subprogram
+    end
+  end interface
+  func = 0
+contains
+  integer function inner_func()
+     !$omp assumes no_parallelism absent(teams) ! OK internal function/subprogram
+     inner_sub2 = 0
+  end
+end
+
+module m
+  integer ::x 
+  !$omp assumes contains(target) holds(x > 0.0)
+
+    interface
+      subroutine mod_mod_sub_iterface()
+        !$omp assumes no_openmp_routines absent(simd) !  OK inferface of an external subroutine/subprogram
+      end
+      integer function mod_mod_func_iterface()
+        !$omp assumes no_openmp_routines absent(error) !  OK inferface of an external subroutine/subprogram
+      end
+    end interface
+
+contains
+  subroutine mod_sub
+    interface
+      subroutine mod_sub_iterface()
+        !$omp assumes no_openmp_routines absent(simd) !  OK inferface of an external subroutine/subprogram
+      end
+    end interface
+    !$omp assumes no_openmp_routines absent(simd) !  OK module subroutine/subprogram
+  contains
+    subroutine mod_inner_sub
+       !$omp assumes no_parallelism absent(teams) ! OK internal subroutine/subprogram
+    end
+  end
+
+  integer function mod_func ()
+    !$omp assumes no_openmp_routines absent(simd) !  OK module function/subprogram
+    interface
+      integer function mod_func_iterface()
+        !$omp assumes no_openmp_routines absent(simd) !  OK inferface of an external function/subprogram
+      end
+    end interface
+    mod_func = 0
+  contains
+    integer function mod_inner_func()
+       !$omp assumes no_parallelism absent(teams) ! OK internal function/subprogram
+       mod_inner_sub2 = 0
+    end
+  end
+end module m
+
+
+! PROGRAM - invalid as:
+!  main program is a program unit that is not a subprogram
+!$omp assumes no_openmp absent(simd)  ! { dg-error "must be in the specification part of a subprogram or module" }
+  block
+    ! invalid: block
+    !$omp assumes no_openmp absent(target)  ! { dg-error "must be in the specification part of a subprogram or module" }
+  end block
+end
diff --git a/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90 b/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90
new file mode 100644
index 00000000000..729c9737a1c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/assumes-2.f90
@@ -0,0 +1,19 @@
+module m
+  integer ::x 
+! Nonsense but OpenMP-semantically valid:
+  !$omp assumes contains(target) holds(x > 0.0)
+  !$omp assumes absent(target)
+  !$omp assumes holds(0.0)
+! { dg-error "HOLDS expression at .1. must be a logical expression" "" { target *-*-* } .-1 }
+end module
+
+module m2
+interface
+  subroutine foo
+    !$omp assumes contains(target) contains(teams,target) ! { dg-error "'TARGET' directive mentioned multiple times in CONTAINS clause in !.OMP ASSUMES directive" }
+    !$omp assumes absent(declare target) ! { dg-error "Invalid 'DECLARE TARGET' directive at .1. in ABSENT clause: declarative, informational and meta directives not permitted" }
+    !$omp assumes absent(parallel) absent(do,simd,parallel,distribute) ! { dg-error "'PARALLEL' directive mentioned multiple times in ABSENT clause in !.OMP ASSUMES directive" }
+    !$omp assumes contains(barrier,atomic) absent(cancel,simd,atomic,distribute) ! { dg-error "'SIMD' directive mentioned both times in ABSENT and CONTAINS clauses in !.OMP ASSUMES directive" }
+  end subroutine foo
+end interface
+end module m2
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index d170594921f..d8c798cf7a1 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -287,7 +287,7 @@ The OpenMP 4.5 specification is fully supported.
       @code{append_args} @tab N @tab
 @item @code{dispatch} construct @tab N @tab
 @item device-specific ICV settings with environment variables @tab Y @tab
-@item @code{assume} directive @tab P @tab Only C/C++
+@item @code{assume} directive @tab Y @tab
 @item @code{nothing} directive @tab Y @tab
 @item @code{error} directive @tab Y @tab
 @item @code{masked} construct @tab Y @tab