public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-12] Add parsing support for allocate directive (OpenMP 5.0)
@ 2022-06-29 14:44 Kwok Yeung
0 siblings, 0 replies; only message in thread
From: Kwok Yeung @ 2022-06-29 14:44 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:491478d12b83e102f72858e8a871a25c951df293
commit 491478d12b83e102f72858e8a871a25c951df293
Author: Hafiz Abid Qadeer <abidh@codesourcery.com>
Date: Wed Mar 9 11:36:04 2022 +0000
Add parsing support for allocate directive (OpenMP 5.0)
Currently we only make use of this directive when it is associated
with an allocate statement.
Backport of a patch posted at
https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588368.html
gcc/fortran/ChangeLog:
* dump-parse-tree.cc (show_omp_node): Handle EXEC_OMP_ALLOCATE.
(show_code_node): Likewise.
* gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATE.
(OMP_LIST_ALLOCATOR): New enum value.
(enum gfc_exec_op): Add EXEC_OMP_ALLOCATE.
* match.h (gfc_match_omp_allocate): New function.
* openmp.cc (enum omp_mask1): Add OMP_CLAUSE_ALLOCATOR.
(OMP_ALLOCATE_CLAUSES): New define.
(gfc_match_omp_allocate): New function.
(resolve_omp_clauses): Add ALLOCATOR in clause_names.
(omp_code_to_statement): Handle EXEC_OMP_ALLOCATE.
(EMPTY_VAR_LIST): New define.
(check_allocate_directive_restrictions): New function.
(gfc_resolve_omp_allocate): Likewise.
(gfc_resolve_omp_directive): Handle EXEC_OMP_ALLOCATE.
* parse.cc (decode_omp_directive): Handle ST_OMP_ALLOCATE.
(next_statement): Likewise.
(gfc_ascii_statement): Likewise.
* resolve.cc (gfc_resolve_code): Handle EXEC_OMP_ALLOCATE.
* st.cc (gfc_free_statement): Likewise.
* trans.cc (trans_code): Likewise
Diff:
---
gcc/fortran/ChangeLog.omp | 27 ++++
gcc/fortran/dump-parse-tree.cc | 3 +
gcc/fortran/gfortran.h | 4 +-
gcc/fortran/match.h | 1 +
gcc/fortran/openmp.cc | 199 +++++++++++++++++++++++++-
gcc/fortran/parse.cc | 10 +-
gcc/fortran/resolve.cc | 1 +
gcc/fortran/st.cc | 1 +
gcc/fortran/trans.cc | 1 +
gcc/testsuite/ChangeLog.omp | 8 ++
gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 112 +++++++++++++++
gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 73 ++++++++++
12 files changed, 435 insertions(+), 5 deletions(-)
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index a9815696d21..06ea51bf417 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,30 @@
+2022-03-09 Abid Qadeer <abidh@codesourcery.com>
+
+ Backport of a patch posted at
+ https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588368.html
+
+ * dump-parse-tree.cc (show_omp_node): Handle EXEC_OMP_ALLOCATE.
+ (show_code_node): Likewise.
+ * gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATE.
+ (OMP_LIST_ALLOCATOR): New enum value.
+ (enum gfc_exec_op): Add EXEC_OMP_ALLOCATE.
+ * match.h (gfc_match_omp_allocate): New function.
+ * openmp.cc (enum omp_mask1): Add OMP_CLAUSE_ALLOCATOR.
+ (OMP_ALLOCATE_CLAUSES): New define.
+ (gfc_match_omp_allocate): New function.
+ (resolve_omp_clauses): Add ALLOCATOR in clause_names.
+ (omp_code_to_statement): Handle EXEC_OMP_ALLOCATE.
+ (EMPTY_VAR_LIST): New define.
+ (check_allocate_directive_restrictions): New function.
+ (gfc_resolve_omp_allocate): Likewise.
+ (gfc_resolve_omp_directive): Handle EXEC_OMP_ALLOCATE.
+ * parse.cc (decode_omp_directive): Handle ST_OMP_ALLOCATE.
+ (next_statement): Likewise.
+ (gfc_ascii_statement): Likewise.
+ * resolve.cc (gfc_resolve_code): Handle EXEC_OMP_ALLOCATE.
+ * st.cc (gfc_free_statement): Likewise.
+ * trans.cc (trans_code): Likewise
+
2022-03-08 Abid Qadeer <abidh@codesourcery.com>
* parse.cc (gfc_parse_file): Set OMP_REQUIRES_DYNAMIC_ALLOCATORS
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 9f7c26fa345..5cde46abea9 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -1995,6 +1995,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_ALLOCATE: name = "ALLOCATE"; break;
case EXEC_OMP_ATOMIC: name = "ATOMIC"; break;
case EXEC_OMP_BARRIER: name = "BARRIER"; break;
case EXEC_OMP_CANCEL: name = "CANCEL"; break;
@@ -2197,6 +2198,7 @@ show_omp_node (int level, gfc_code *c)
|| c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA
|| c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN
|| c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR
+ || c->op == EXEC_OMP_ALLOCATE
|| (c->op == EXEC_OMP_ORDERED && c->block == NULL))
return;
if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS)
@@ -3340,6 +3342,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_ALLOCATE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 466e3bfab46..9f1e78576ce 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -259,7 +259,7 @@ enum gfc_statement
ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP,
ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL,
ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE,
- ST_OACC_ATOMIC, ST_OACC_END_ATOMIC,
+ ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, ST_OMP_ALLOCATE,
ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC,
ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED,
ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS,
@@ -1396,6 +1396,7 @@ enum
OMP_LIST_USE_DEVICE_ADDR,
OMP_LIST_NONTEMPORAL,
OMP_LIST_ALLOCATE,
+ OMP_LIST_ALLOCATOR,
OMP_LIST_HAS_DEVICE_ADDR,
OMP_LIST_NUM /* Must be the last. */
};
@@ -2913,6 +2914,7 @@ enum gfc_exec_op
EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE,
EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA,
EXEC_OACC_ATOMIC, EXEC_OACC_DECLARE,
+ EXEC_OMP_ALLOCATE,
EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 5bfdfa9b369..dab32486320 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -149,6 +149,7 @@ 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_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 9b66f21ae0e..fb59d9b6b46 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -970,6 +970,7 @@ enum omp_mask2
OMP_CLAUSE_FINALIZE,
OMP_CLAUSE_ATTACH,
OMP_CLAUSE_NOHOST,
+ OMP_CLAUSE_ALLOCATOR,
OMP_CLAUSE_HAS_DEVICE_ADDR, /* OpenMP 5.1 */
/* This must come last. */
OMP_MASK2_LAST
@@ -3621,6 +3622,7 @@ cleanup:
}
+#define OMP_ALLOCATE_CLAUSES (omp_mask (OMP_CLAUSE_ALLOCATOR))
#define OMP_PARALLEL_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \
@@ -5986,6 +5988,64 @@ gfc_match_omp_ordered_depend (void)
return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND));
}
+/* omp allocate (list) [clause-list]
+ - clause-list: allocator
+*/
+
+match
+gfc_match_omp_allocate (void)
+{
+ gfc_omp_clauses *c = gfc_get_omp_clauses ();
+ gfc_expr *allocator = NULL;
+ match m;
+
+ m = gfc_match (" (");
+ if (m == MATCH_YES)
+ {
+ m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATOR],
+ true, NULL);
+
+ if (m != MATCH_YES)
+ {
+ /* If the list was empty, we must find closing ')'. */
+ m = gfc_match (")");
+ if (m != MATCH_YES)
+ return m;
+ }
+ }
+
+ if (gfc_match (" allocator ( ") == MATCH_YES)
+ {
+ m = gfc_match_expr (&allocator);
+ if (m != MATCH_YES)
+ {
+ gfc_error ("Expected allocator at %C");
+ return MATCH_ERROR;
+ }
+ if (gfc_match (" ) ") != MATCH_YES)
+ {
+ gfc_error ("Expected ')' at %C");
+ gfc_free_expr (allocator);
+ return MATCH_ERROR;
+ }
+ }
+
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_free_expr (allocator);
+ gfc_error ("Unexpected junk after $OMP allocate at %C");
+ return MATCH_ERROR;
+ }
+ gfc_omp_namelist *n;
+ for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next)
+ n->expr = gfc_copy_expr (allocator);
+
+ new_st.op = EXEC_OMP_ALLOCATE;
+ new_st.ext.omp_clauses = c;
+ gfc_free_expr (allocator);
+ return MATCH_YES;
+}
+
/* omp atomic [clause-list]
- atomic-clause: read | write | update
@@ -6467,7 +6527,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
"IN_REDUCTION", "TASK_REDUCTION",
"DEVICE_RESIDENT", "LINK", "USE_DEVICE",
"CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR",
- "NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR" };
+ "NONTEMPORAL", "ALLOCATE", "ALLOCATOR", "HAS_DEVICE_ADDR" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
@@ -8842,6 +8902,8 @@ omp_code_to_statement (gfc_code *code)
{
switch (code->op)
{
+ case EXEC_OMP_ALLOCATE:
+ return ST_OMP_ALLOCATE;
case EXEC_OMP_PARALLEL:
return ST_OMP_PARALLEL;
case EXEC_OMP_PARALLEL_MASKED:
@@ -9347,6 +9409,138 @@ gfc_resolve_oacc_routines (gfc_namespace *ns)
}
}
+static void
+check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al,
+ gfc_namespace *ns, locus loc)
+{
+ if (sym->attr.save != SAVE_NONE || sym->attr.in_common == 1
+ || sym->module != NULL)
+ {
+ int tmp;
+ /* Assumption here is that we can extract an integer then
+ it is a predefined thing. */
+ if (!omp_al || gfc_extract_int (omp_al, &tmp))
+ gfc_error ("%qs should use predefined allocator at %L", sym->name,
+ &loc);
+ }
+ if (ns != sym->ns)
+ gfc_error ("%qs is not in the same scope as %<allocate%>"
+ " directive at %L", sym->name, &loc);
+}
+
+#define EMPTY_VAR_LIST(node) \
+ (node->ext.omp_clauses->lists[OMP_LIST_ALLOCATOR] == NULL)
+
+static void
+gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns)
+{
+ gfc_alloc *al;
+ gfc_omp_namelist *n = NULL;
+ gfc_omp_namelist *cn = NULL;
+ gfc_omp_namelist *p, *tail;
+ gfc_code *cur;
+ hash_set<gfc_symbol*> vars;
+
+ gfc_omp_clauses *clauses = code->ext.omp_clauses;
+ gcc_assert (clauses);
+ cn = clauses->lists[OMP_LIST_ALLOCATOR];
+ gfc_expr *omp_al = cn ? cn->expr : NULL;
+
+ if (omp_al && (omp_al->ts.type != BT_INTEGER
+ || omp_al->ts.kind != gfc_c_intptr_kind))
+ gfc_error ("Expected integer expression of the "
+ "%<omp_allocator_handle_kind%> kind at %L", &omp_al->where);
+
+ /* Check that variables in this allocate directive are not duplicated
+ in this directive or others coming directly after it. */
+ for (cur = code; cur != NULL && cur->op == EXEC_OMP_ALLOCATE;
+ cur = cur->next)
+ {
+ gfc_omp_clauses *c = cur->ext.omp_clauses;
+ gcc_assert (c);
+ for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next)
+ {
+ if (vars.contains (n->sym))
+ gfc_error ("%qs is used in multiple %<allocate%> "
+ "directives at %L", n->sym->name, &cur->loc);
+ /* This helps us avoid duplicate error messages. */
+ if (cur == code)
+ vars.add (n->sym);
+ }
+ }
+
+ if (cur == NULL || cur->op != EXEC_ALLOCATE)
+ {
+ /* There is no allocate statement right after allocate directive.
+ We don't support this case at the moment. */
+ for (n = cn; n != NULL; n = n->next)
+ {
+ gfc_symbol *sym = n->sym;
+ if (sym->attr.allocatable == 1)
+ gfc_error ("%qs with ALLOCATABLE attribute is not allowed in "
+ "%<allocate%> directive at %L as this directive is not"
+ " associated with an %<allocate%> statement.",
+ sym->name, &code->loc);
+ }
+ sorry_at (code->loc.lb->location, "%<allocate%> directive that is "
+ "not associated with an %<allocate%> statement is not "
+ "supported.");
+ return;
+ }
+
+ /* If there is another allocate directive right after this one, check
+ that none of them is empty. Doing it this way, we can check this
+ thing even when multiple directives are together and generate
+ error at right location. */
+ if (code->next && code->next->op == EXEC_OMP_ALLOCATE
+ && (EMPTY_VAR_LIST (code) || EMPTY_VAR_LIST (code->next)))
+ gfc_error ("Empty variable list is not allowed at %L when multiple "
+ "%<allocate%> directives are associated with an "
+ "%<allocate%> statement.",
+ EMPTY_VAR_LIST (code) ? &code->loc : &code->next->loc);
+
+ if (EMPTY_VAR_LIST (code))
+ {
+ /* Empty namelist means allocate directive applies to all
+ variables in allocate statement. 'cur' points to associated
+ allocate statement. */
+ for (al = cur->ext.alloc.list; al != NULL; al = al->next)
+ if (al->expr && al->expr->symtree && al->expr->symtree->n.sym)
+ {
+ check_allocate_directive_restrictions (al->expr->symtree->n.sym,
+ omp_al, ns, code->loc);
+ p = gfc_get_omp_namelist ();
+ p->sym = al->expr->symtree->n.sym;
+ p->expr = omp_al;
+ p->where = code->loc;
+ if (cn == NULL)
+ cn = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ }
+ clauses->lists[OMP_LIST_ALLOCATOR]= cn;
+ }
+ else
+ {
+ for (n = cn; n != NULL; n = n->next)
+ {
+ for (al = cur->ext.alloc.list; al != NULL; al = al->next)
+ if (al->expr && al->expr->symtree && al->expr->symtree->n.sym
+ && al->expr->symtree->n.sym == n->sym)
+ break;
+ if (al == NULL)
+ gfc_error ("%qs in %<allocate%> directive at %L is not present "
+ "in associated %<allocate%> statement.",
+ n->sym->name, &code->loc);
+ check_allocate_directive_restrictions (n->sym, omp_al, ns,
+ code->loc);
+ }
+ }
+}
+
void
gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
@@ -9491,6 +9685,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
case EXEC_OMP_METADIRECTIVE:
resolve_omp_metadirective (code, ns);
break;
+ case EXEC_OMP_ALLOCATE:
+ gfc_resolve_omp_allocate (code, ns);
+ break;
default:
break;
}
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 14c31d53b27..25fab8178c5 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -890,6 +890,7 @@ decode_omp_directive (void)
{
case 'a':
matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC);
+ matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE);
break;
case 'b':
matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER);
@@ -1692,9 +1693,9 @@ next_statement (void)
case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \
case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \
case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \
- case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \
- case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \
- case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
+ case ST_OMP_ALLOCATE: case ST_ERROR_STOP: case ST_OMP_SCAN: \
+ case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: \
+ case ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: \
case ST_END_TEAM: case ST_SYNC_TEAM: \
case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \
case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \
@@ -2408,6 +2409,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_OACC_END_ATOMIC:
p = "!$ACC END ATOMIC";
break;
+ case ST_OMP_ALLOCATE:
+ p = "!$OMP ALLOCATE";
+ break;
case ST_OMP_ATOMIC:
p = "!$OMP ATOMIC";
break;
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 59df31b2a69..36bc6328a9c 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -12349,6 +12349,7 @@ start:
gfc_resolve_oacc_directive (code, ns);
break;
+ case EXEC_OMP_ALLOCATE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_BARRIER:
case EXEC_OMP_CANCEL:
diff --git a/gcc/fortran/st.cc b/gcc/fortran/st.cc
index dca11886395..8256ab9b832 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_ALLOCATE:
case EXEC_OMP_ATOMIC:
case EXEC_OMP_CANCEL:
case EXEC_OMP_CANCELLATION_POINT:
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 6923b2bef34..d79bea4e0e9 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_ALLOCATE:
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 978e183a7f4..1fc78beb40b 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,11 @@
+2022-03-09 Abid Qadeer <abidh@codesourcery.com>
+
+ Backport of a patch posted at
+ https://gcc.gnu.org/pipermail/gcc-patches/2022-January/588368.html
+
+ * gfortran.dg/gomp/allocate-4.f90: New test.
+ * gfortran.dg/gomp/allocate-5.f90: New test.
+
2022-03-08 Abid Qadeer <abidh@codesourcery.com>
* c-c++-common/gomp/allocate-2.c: Add tests.
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
new file mode 100644
index 00000000000..3f512d66495
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
@@ -0,0 +1,112 @@
+! { dg-do compile }
+
+module test
+ integer, allocatable :: mvar1
+ integer, allocatable :: mvar2
+ integer, allocatable :: mvar3
+end module
+
+subroutine foo(x, y)
+ use omp_lib
+ implicit none
+ integer :: x
+ integer :: y
+
+ integer, allocatable :: var1(:)
+ integer, allocatable :: var2(:)
+ integer, allocatable :: var3(:)
+ integer, allocatable :: var4(:)
+ integer, allocatable :: var5(:)
+ integer, allocatable :: var6(:)
+ integer, allocatable :: var7(:)
+ integer, allocatable :: var8(:)
+ integer, allocatable :: var9(:)
+
+ !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
+ allocate (var1(x))
+
+ !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
+ allocate (var3(x))
+
+ !$omp allocate (x) ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." }
+ x = 2
+
+ !$omp allocate (var4) ! { dg-error "'var4' with ALLOCATABLE attribute is not allowed in 'allocate' directive at .1. as this directive is not associated with an 'allocate' statement." }
+ ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." "" { target *-*-* } .-1 }
+ y = 2
+
+ !$omp allocate (var5)
+ !$omp allocate ! { dg-error "Empty variable list is not allowed at .1. when multiple 'allocate' directives are associated with an 'allocate' statement." }
+ allocate (var5(x))
+
+ !$omp allocate (var6)
+ !$omp allocate (var7) ! { dg-error "'var7' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
+ !$omp allocate (var8) ! { dg-error "'var8' in 'allocate' directive at .1. is not present in associated 'allocate' statement." }
+ allocate (var6(x))
+
+ !$omp allocate (var9)
+ !$omp allocate (var9) ! { dg-error "'var9' is used in multiple 'allocate' directives at .1." }
+ allocate (var9(x))
+
+end subroutine
+
+function outer(a)
+ IMPLICIT NONE
+
+ integer :: outer, a
+ integer, allocatable :: var1
+
+ outer = inner(a) + 5
+ return
+
+ contains
+
+ integer function inner(x)
+ integer :: x
+ integer, allocatable :: var2
+
+ !$omp allocate (var1, var2) ! { dg-error "'var1' is not in the same scope as 'allocate' directive at .1." }
+ allocate (var1, var2)
+
+ inner = x + 10
+ return
+ end function inner
+
+end function outer
+
+subroutine bar(s)
+ use omp_lib
+ use test
+ integer :: s
+ integer, save, allocatable :: svar1
+ integer, save, allocatable :: svar2
+ integer, save, allocatable :: svar3
+
+ type (omp_alloctrait) :: traits(3)
+ integer (omp_allocator_handle_kind) :: a
+
+ traits = [omp_alloctrait (omp_atk_alignment, 64), &
+ omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), &
+ omp_alloctrait (omp_atk_pool_size, 8192)]
+ a = omp_init_allocator (omp_default_mem_space, 3, traits)
+ if (a == omp_null_allocator) stop 1
+
+ !$omp allocate (mvar1) allocator(a) ! { dg-error "'mvar1' should use predefined allocator at .1." }
+ allocate (mvar1)
+
+ !$omp allocate (mvar2) ! { dg-error "'mvar2' should use predefined allocator at .1." }
+ allocate (mvar2)
+
+ !$omp allocate (mvar3) allocator(omp_low_lat_mem_alloc)
+ allocate (mvar3)
+
+ !$omp allocate (svar1) allocator(a) ! { dg-error "'svar1' should use predefined allocator at .1." }
+ allocate (svar1)
+
+ !$omp allocate (svar2) ! { dg-error "'svar2' should use predefined allocator at .1." }
+ allocate (svar2)
+
+ !$omp allocate (svar3) allocator(omp_low_lat_mem_alloc)
+ allocate (svar3)
+end subroutine
+
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
new file mode 100644
index 00000000000..761b6dede28
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
@@ -0,0 +1,73 @@
+! { dg-do compile }
+
+module omp_lib_kinds
+ use iso_c_binding, only: c_int, c_intptr_t
+ implicit none
+ private :: c_int, c_intptr_t
+ integer, parameter :: omp_allocator_handle_kind = c_intptr_t
+
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_null_allocator = 0
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_default_mem_alloc = 1
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_large_cap_mem_alloc = 2
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_const_mem_alloc = 3
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_high_bw_mem_alloc = 4
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_low_lat_mem_alloc = 5
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_cgroup_mem_alloc = 6
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_pteam_mem_alloc = 7
+ integer (kind=omp_allocator_handle_kind), &
+ parameter :: omp_thread_mem_alloc = 8
+end module
+
+subroutine foo(x, y)
+ use omp_lib_kinds
+ implicit none
+ integer :: x
+ integer :: y
+
+ integer, allocatable :: var1(:)
+ integer, allocatable :: var2(:)
+ integer, allocatable :: var3(:)
+ integer, allocatable :: var4(:,:)
+ integer, allocatable :: var5(:)
+ integer, allocatable :: var6(:)
+ integer, allocatable :: var7(:)
+ integer, allocatable :: var8(:)
+ integer, allocatable :: var9(:)
+ integer, allocatable :: var10(:)
+ integer, allocatable :: var11(:)
+ integer, allocatable :: var12(:)
+
+ !$omp allocate (var1) allocator(omp_default_mem_alloc)
+ allocate (var1(x))
+
+ !$omp allocate (var2)
+ allocate (var2(x))
+
+ !$omp allocate (var3, var4) allocator(omp_large_cap_mem_alloc)
+ allocate (var3(x),var4(x,y))
+
+ !$omp allocate()
+ allocate (var5(x))
+
+ !$omp allocate
+ allocate (var6(x))
+
+ !$omp allocate () allocator(omp_default_mem_alloc)
+ allocate (var7(x))
+
+ !$omp allocate allocator(omp_default_mem_alloc)
+ allocate (var8(x))
+
+ !$omp allocate (var9) allocator(omp_default_mem_alloc)
+ !$omp allocate (var10) allocator(omp_large_cap_mem_alloc)
+ allocate (var9(x), var10(x))
+
+end subroutine
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-06-29 14:44 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-06-29 14:44 [gcc/devel/omp/gcc-12] Add parsing support for allocate directive (OpenMP 5.0) Kwok Yeung
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).