From: Andrew Stubbs <ams@codesourcery.com>
To: <gcc-patches@gcc.gnu.org>
Subject: [PATCH 10/17] Add parsing support for allocate directive (OpenMP 5.0)
Date: Thu, 7 Jul 2022 11:34:41 +0100 [thread overview]
Message-ID: <c00649080f9127a0eeabb45536a2846ffc4c3fa7.1657188329.git.ams@codesourcery.com> (raw)
In-Reply-To: <cover.1657188329.git.ams@codesourcery.com>
[-- Attachment #1: Type: text/plain, Size: 1863 bytes --]
Currently we only make use of this directive when it is associated
with an allocate statement.
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
---
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/gfortran.dg/gomp/allocate-4.f90 | 112 ++++++++++
gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 73 +++++++
10 files changed, 400 insertions(+), 5 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-4.f90
create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-5.f90
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0010-Add-parsing-support-for-allocate-directive-OpenMP-5..patch --]
[-- Type: text/x-patch; name="0010-Add-parsing-support-for-allocate-directive-OpenMP-5..patch", Size: 20254 bytes --]
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index 5352008a63d..e0c6c0d9d96 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -2003,6 +2003,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;
@@ -2204,6 +2205,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)
@@ -3329,6 +3331,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 696aadd7db6..755469185a6 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,
@@ -1398,6 +1398,7 @@ enum
OMP_LIST_USE_DEVICE_ADDR,
OMP_LIST_NONTEMPORAL,
OMP_LIST_ALLOCATE,
+ OMP_LIST_ALLOCATOR,
OMP_LIST_HAS_DEVICE_ADDR,
OMP_LIST_ENTER,
OMP_LIST_NUM /* Must be the last. */
@@ -2908,6 +2909,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 495c93e0b5c..fe43d4b3fd3 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_cancel (void);
diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc
index 91bf8a3c50d..38003890bb0 100644
--- a/gcc/fortran/openmp.cc
+++ b/gcc/fortran/openmp.cc
@@ -986,6 +986,7 @@ enum omp_mask2
OMP_CLAUSE_FINALIZE,
OMP_CLAUSE_ATTACH,
OMP_CLAUSE_NOHOST,
+ OMP_CLAUSE_ALLOCATOR,
OMP_CLAUSE_HAS_DEVICE_ADDR, /* OpenMP 5.1 */
OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
/* This must come last. */
@@ -3784,6 +3785,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 \
@@ -6001,6 +6003,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
@@ -6482,7 +6542,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", "ENTER" };
+ "NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR", "ENTER", "ALLOCATOR" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
@@ -9006,6 +9066,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:
@@ -9486,6 +9548,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)
@@ -9627,6 +9821,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns)
code->ext.omp_clauses->if_present = false;
resolve_omp_clauses (code, code->ext.omp_clauses, ns);
break;
+ case EXEC_OMP_ALLOCATE:
+ gfc_resolve_omp_allocate (code, ns);
+ break;
default:
break;
}
diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc
index 0b4c596996c..97d182d46ad 100644
--- a/gcc/fortran/parse.cc
+++ b/gcc/fortran/parse.cc
@@ -886,6 +886,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);
@@ -1673,9 +1674,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: \
@@ -2352,6 +2353,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 2ebf076f730..65f24b88067 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -12368,6 +12368,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 73f30c2137f..7b282e96c3d 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 912a206f2ed..a9d5714be22 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/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
next prev parent reply other threads:[~2022-07-07 10:37 UTC|newest]
Thread overview: 30+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-07-07 10:34 [PATCH 00/17] openmp, nvptx, amdgcn: 5.0 Memory Allocators Andrew Stubbs
2022-07-07 10:34 ` [PATCH 01/17] libgomp, nvptx: low-latency memory allocator Andrew Stubbs
2022-12-08 11:40 ` Jakub Jelinek
2022-07-07 10:34 ` [PATCH 02/17] libgomp: pinned memory Andrew Stubbs
2022-12-08 12:11 ` Jakub Jelinek
2022-12-08 12:51 ` Andrew Stubbs
2022-12-08 14:02 ` Tobias Burnus
2022-12-08 14:35 ` Andrew Stubbs
2022-12-08 15:02 ` Tobias Burnus
2022-07-07 10:34 ` [PATCH 03/17] libgomp, openmp: Add ompx_pinned_mem_alloc Andrew Stubbs
2022-07-07 10:34 ` [PATCH 04/17] openmp, nvptx: low-lat memory access traits Andrew Stubbs
2022-07-07 10:34 ` [PATCH 05/17] openmp, nvptx: ompx_unified_shared_mem_alloc Andrew Stubbs
2022-07-07 10:34 ` [PATCH 06/17] openmp: Add -foffload-memory Andrew Stubbs
2022-07-07 10:34 ` [PATCH 07/17] openmp: allow requires unified_shared_memory Andrew Stubbs
2022-07-07 10:34 ` [PATCH 08/17] openmp: -foffload-memory=pinned Andrew Stubbs
2022-07-07 11:54 ` Tobias Burnus
2022-07-07 22:18 ` Andrew Stubbs
2022-07-08 9:00 ` Tobias Burnus
2022-07-08 9:55 ` Andrew Stubbs
2022-07-08 9:57 ` Tobias Burnus
2023-02-20 14:59 ` Prototype 'GOMP_enable_pinned_mode' (was: [PATCH 08/17] openmp: -foffload-memory=pinned) Thomas Schwinge
2022-07-07 10:34 ` [PATCH 09/17] openmp: Use libgomp memory allocation functions with unified shared memory Andrew Stubbs
2022-07-07 10:34 ` Andrew Stubbs [this message]
2022-07-07 10:34 ` [PATCH 11/17] Translate allocate directive (OpenMP 5.0) Andrew Stubbs
2022-07-07 10:34 ` [PATCH 12/17] Handle cleanup of omp allocated variables " Andrew Stubbs
2022-07-07 10:34 ` [PATCH 13/17] Gimplify allocate directive " Andrew Stubbs
2022-07-07 10:34 ` [PATCH 14/17] Lower " Andrew Stubbs
2022-07-07 10:34 ` [PATCH 15/17] amdgcn: Support XNACK mode Andrew Stubbs
2022-07-07 10:34 ` [PATCH 16/17] amdgcn, openmp: Auto-detect USM mode and set HSA_XNACK Andrew Stubbs
2022-07-07 10:34 ` [PATCH 17/17] amdgcn: libgomp plugin USM implementation Andrew Stubbs
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=c00649080f9127a0eeabb45536a2846ffc4c3fa7.1657188329.git.ams@codesourcery.com \
--to=ams@codesourcery.com \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).