public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-12] Fortran: Add OpenMP's assume(s) directives
@ 2022-10-05 19:39 Tobias Burnus
  0 siblings, 0 replies; only message in thread
From: Tobias Burnus @ 2022-10-05 19:39 UTC (permalink / raw)
  To: gcc-cvs

https://gcc.gnu.org/g:249a6ce03ccda342fc3ba468c73eb39622b1047c

commit 249a6ce03ccda342fc3ba468c73eb39622b1047c
Author: Tobias Burnus <tobias@codesourcery.com>
Date:   Wed Oct 5 21:38:48 2022 +0200

    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.
    
    (cherry picked from commit e2a228438919d846995bf2c839c9b657442224b2)

Diff:
---
 gcc/fortran/ChangeLog.omp                    |  43 +++
 gcc/fortran/dump-parse-tree.cc               |  41 +++
 gcc/fortran/gfortran.h                       |  23 +-
 gcc/fortran/match.h                          |   2 +
 gcc/fortran/openmp.cc                        | 404 +++++++++++++++++++++++++++
 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/ChangeLog.omp                  |  10 +
 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/ChangeLog.omp                        |   7 +
 libgomp/libgomp.texi                         |   2 +-
 19 files changed, 725 insertions(+), 9 deletions(-)

diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index e1f67c8c0c3..c0da9049a32 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,46 @@
+2022-10-05  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backport from mainline:
+	2022-10-05  Tobias Burnus  <tobias@codesourcery.com>
+
+	* 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.
+
 2022-10-05  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline:
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 04ee9c1dacc..ae29edb0b93 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;
@@ -1472,6 +1473,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.  */
 
@@ -2013,6 +2042,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
@@ -2043,6 +2074,7 @@ show_omp_node (int level, gfc_code *c)
     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_ALLOCATE: name = "ALLOCATE"; 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;
@@ -2145,6 +2177,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:
@@ -3390,6 +3423,7 @@ show_code_node (int level, gfc_code *c)
     case EXEC_OACC_ENTER_DATA:
     case EXEC_OACC_EXIT_DATA:
     case EXEC_OMP_ALLOCATE:
+    case EXEC_OMP_ASSUME:
     case EXEC_OMP_ATOMIC:
     case EXEC_OMP_CANCEL:
     case EXEC_OMP_CANCELLATION_POINT:
@@ -3569,6 +3603,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 849c6226653..97c30fd3a5f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -317,7 +317,9 @@ enum gfc_statement
   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
+  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
@@ -1513,6 +1515,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];
@@ -1536,6 +1550,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;
@@ -2165,6 +2180,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.  */
 
@@ -2931,7 +2949,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,
@@ -3597,6 +3615,7 @@ 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_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 dab32486320..1e1ce2b1eeb 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -150,6 +150,8 @@ match gfc_match_oacc_routine (void);
 /* OpenMP directive matchers.  */
 match gfc_match_omp_eos_error (void);
 match gfc_match_omp_allocate (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_begin_metadirective (void);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 9ca26f71027..ab9db4e3a65 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -30,6 +30,86 @@ along with GCC; see the file COPYING3.  If not see
 #include "gomp-constants.h"
 #include "target-memory.h"  /* For gfc_encode_character.  */
 #include "options.h"
+#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 '!'.  In the special case where a
@@ -121,6 +201,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);
 }
 
@@ -1017,6 +1104,7 @@ enum omp_mask2
   OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
   OMP_CLAUSE_USES_ALLOCATORS,
   OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
+  OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */
   /* This must come last.  */
   OMP_MASK2_LAST
 };
@@ -1955,6 +2043,174 @@ gfc_match_omp_clause_uses_allocators (gfc_omp_clauses *c)
 #endif
 }
 
+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,
    it matches a ' ( ' after 'name'.
@@ -2057,6 +2313,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],
@@ -2289,6 +2553,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],
@@ -2823,6 +3095,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],
@@ -3210,6 +3496,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)
@@ -4489,6 +4810,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)
 {
@@ -7294,6 +7678,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
@@ -8671,6 +9069,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);
 }
 
 
@@ -9906,6 +10307,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:
@@ -10611,6 +11014,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 28d9cccdd25..5c91390f69b 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -889,6 +889,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);
       matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE);
       break;
@@ -920,6 +922,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,
@@ -1737,6 +1740,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: \
@@ -1754,7 +1758,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
 
 /* OpenMP statements that are followed by a structured block.  */
@@ -1766,7 +1770,7 @@ next_statement (void)
   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_TASKGROUP: case ST_OMP_ASSUME: \
   case ST_OMP_WORKSHARE: case ST_OMP_PARALLEL_WORKSHARE
 
 /* OpenMP statements that are followed by a do loop.  */
@@ -1983,10 +1987,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;
 
@@ -2414,6 +2419,12 @@ gfc_ascii_statement (gfc_statement st)
     case ST_OMP_ALLOCATE:
       p = "!$OMP ALLOCATE";
       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;
@@ -2465,6 +2476,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;
@@ -2670,6 +2684,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;
@@ -2821,6 +2839,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;
 }
 
@@ -5295,6 +5315,8 @@ gfc_omp_end_stmt (gfc_statement omp_st,
     {
       switch (omp_st)
 	{
+	case ST_OMP_ASSUME:
+	  return ST_OMP_END_ASSUME;
 	case ST_OMP_PARALLEL:
 	  return ST_OMP_END_PARALLEL;
 	case ST_OMP_PARALLEL_MASKED:
@@ -5715,6 +5737,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:
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index b66dbf5cf2f..b2e523fc91c 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -67,7 +67,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) ;
 gfc_statement gfc_omp_end_stmt (gfc_statement, bool = true, bool = true);
 match gfc_match_enum (void);
 match gfc_match_enumerator_def (void);
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 782d1699735..81e3793710e 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -10897,6 +10897,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:
@@ -12350,6 +12351,7 @@ start:
 	  break;
 
 	case EXEC_OMP_ALLOCATE:
+	case EXEC_OMP_ASSUME:
 	case EXEC_OMP_ATOMIC:
 	case EXEC_OMP_BARRIER:
 	case EXEC_OMP_CANCEL:
@@ -17638,6 +17640,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 8256ab9b832..90b4417239d 100644
--- a/gcc/fortran/st.cc
+++ b/gcc/fortran/st.cc
@@ -215,6 +215,7 @@ gfc_free_statement (gfc_code *p)
     case EXEC_OACC_EXIT_DATA:
     case EXEC_OACC_ROUTINE:
     case EXEC_OMP_ALLOCATE:
+    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 fc24f8f70ec..f44c0ce76ed 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -4079,7 +4079,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 4105db6aa24..712e3726bea 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -9085,6 +9085,8 @@ gfc_trans_omp_directive (gfc_code *code)
     {
     case EXEC_OMP_ALLOCATE:
       return gfc_trans_omp_allocate (code);
+    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 d79bea4e0e9..3c3bcb4f72f 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -2175,6 +2175,7 @@ trans_code (gfc_code * code, tree cond)
 	  break;
 
 	case EXEC_OMP_ALLOCATE:
+	case EXEC_OMP_ASSUME:
 	case EXEC_OMP_ATOMIC:
 	case EXEC_OMP_BARRIER:
 	case EXEC_OMP_CANCEL:
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index b26b68f3e3e..0fad6f7d103 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,13 @@
+2022-10-05  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backport from mainline:
+	2022-10-05  Tobias Burnus  <tobias@codesourcery.com>
+	
+	* 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.
+
 2022-10-05  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline:
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/ChangeLog.omp b/libgomp/ChangeLog.omp
index 4c90a4ad97b..7353fff2554 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,10 @@
+2022-10-05  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backport from mainline:
+	2022-10-05  Tobias Burnus  <tobias@codesourcery.com>
+
+	* libgomp.texi (OpenMP 5.1 Impl. Status): Mark 'assume' as 'Y'.
+
 2022-10-04  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backport from mainline:
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index 7dbd54374da..513d5e23c6a 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

^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2022-10-05 19:39 UTC | newest]

Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-10-05 19:39 [gcc/devel/omp/gcc-12] Fortran: Add OpenMP's assume(s) directives Tobias Burnus

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).