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).