Add support for allocate clause (OpenMP 5.0).

This patch adds support for OpenMP 5.0 allocate clause for fortran. It does not
yet support the allocator-modifier as specified in OpenMP 5.1. The allocate
clause is already supported in C/C++.

gcc/fortran/ChangeLog:

	* dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE.
	* gfortran.h (OMP_LIST_ALLOCATE): New enum value.
	* openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE.
	(gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE
	(OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES)
	(OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES)
	(OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES)
	(OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE.
	(OMP_TASKGROUP_CLAUSES): New.
	(gfc_match_omp_taskgroup): Use OMP_TASKGROUP_CLAUSES instead of
	OMP_CLAUSE_TASK_REDUCTION.
	(resolve_omp_clauses): Handle OMP_LIST_ALLOCATE.
	(resolve_omp_do): Avoid warning when loop iteration variable is
	in allocate clause.
	* trans-openmp.c (gfc_trans_omp_clauses): Handle translation of
	allocate clause.
	(gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE.

gcc/testsuite/ChangeLog:

	* gfortran.dg/gomp/allocate-1.f90: New test.
	* gfortran.dg/gomp/allocate-2.f90: New test.
	* gfortran.dg/gomp/allocate-3.f90: New test.
	* gfortran.dg/gomp/collapse1.f90: Update error message.
	* gfortran.dg/gomp/openmp-simd-4.f90: Likewise.
	* gfortran.dg/gomp/clauses-1.f90: Uncomment allocate clause.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/allocate-1.c: New test.
	* testsuite/libgomp.fortran/allocate-1.f90: New test.
	* libgomp.texi: Remove string that says that allocate clause
	support is for C/C++ only.
This commit is contained in:
Hafiz Abid Qadeer 2021-09-24 10:04:12 +01:00
parent 49d5fb4fee
commit 69561fc781
13 changed files with 896 additions and 158 deletions

View File

@ -1685,6 +1685,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break;
case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break;
case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break;
case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break;
case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
default:

View File

@ -1392,6 +1392,7 @@ enum
OMP_LIST_USE_DEVICE_PTR,
OMP_LIST_USE_DEVICE_ADDR,
OMP_LIST_NONTEMPORAL,
OMP_LIST_ALLOCATE,
OMP_LIST_NUM
};

View File

@ -912,6 +912,7 @@ enum omp_mask1
OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */
OMP_CLAUSE_DETACH, /* OpenMP 5.0. */
OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */
OMP_CLAUSE_ALLOCATE, /* OpenMP 5.0. */
OMP_CLAUSE_BIND, /* OpenMP 5.0. */
OMP_CLAUSE_FILTER, /* OpenMP 5.1. */
OMP_CLAUSE_AT, /* OpenMP 5.1. */
@ -1549,6 +1550,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
continue;
}
if ((mask & OMP_CLAUSE_ALLOCATE)
&& gfc_match ("allocate ( ") == MATCH_YES)
{
gfc_expr *allocator = NULL;
old_loc = gfc_current_locus;
m = gfc_match_expr (&allocator);
if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES)
{
/* If no ":" then there is no allocator, we backtrack
and read the variable list. */
gfc_free_expr (allocator);
allocator = NULL;
gfc_current_locus = old_loc;
}
gfc_omp_namelist **head = NULL;
m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE],
true, NULL, &head);
if (m != MATCH_YES)
{
gfc_free_expr (allocator);
gfc_error ("Expected variable list at %C");
goto error;
}
for (gfc_omp_namelist *n = *head; n; n = n->next)
if (allocator)
n->expr = gfc_copy_expr (allocator);
else
n->expr = NULL;
gfc_free_expr (allocator);
continue;
}
if ((mask & OMP_CLAUSE_AT)
&& (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true))
!= MATCH_NO)
@ -3572,7 +3607,7 @@ cleanup:
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \
| OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \
| OMP_CLAUSE_PROC_BIND)
| OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE)
#define OMP_DECLARE_SIMD_CLAUSES \
(omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \
| OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \
@ -3581,15 +3616,16 @@ cleanup:
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \
| OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \
| OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER)
| OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
#define OMP_LOOP_CLAUSES \
(omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \
| OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
#define OMP_SCOPE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION)
#define OMP_SECTIONS_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION)
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
#define OMP_SIMD_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \
| OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \
@ -3600,20 +3636,22 @@ cleanup:
| OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \
| OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \
| OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \
| OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY)
| OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE)
#define OMP_TASKLOOP_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \
| OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \
| OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \
| OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP \
| OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION)
| OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE)
#define OMP_TASKGROUP_CLAUSES \
(omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE)
#define OMP_TARGET_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
| OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \
| OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \
| OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \
| OMP_CLAUSE_THREAD_LIMIT)
| OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE)
#define OMP_TARGET_DATA_CLAUSES \
(omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \
| OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR)
@ -3629,13 +3667,14 @@ cleanup:
#define OMP_TEAMS_CLAUSES \
(omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \
| OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION)
| OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE)
#define OMP_DISTRIBUTE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \
| OMP_CLAUSE_ORDER)
| OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE)
#define OMP_SINGLE_CLAUSES \
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE)
(omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \
| OMP_CLAUSE_ALLOCATE)
#define OMP_ORDERED_CLAUSES \
(omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD)
#define OMP_DECLARE_TARGET_CLAUSES \
@ -5905,7 +5944,7 @@ gfc_match_omp_barrier (void)
match
gfc_match_omp_taskgroup (void)
{
return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION);
return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES);
}
@ -6243,7 +6282,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" };
"NONTEMPORAL", "ALLOCATE" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
@ -6529,7 +6568,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
&& list != OMP_LIST_REDUCTION_INSCAN
&& list != OMP_LIST_REDUCTION_TASK
&& list != OMP_LIST_IN_REDUCTION
&& list != OMP_LIST_TASK_REDUCTION)
&& list != OMP_LIST_TASK_REDUCTION
&& list != OMP_LIST_ALLOCATE)
for (n = omp_clauses->lists[list]; n; n = n->next)
{
bool component_ref_p = false;
@ -6598,6 +6638,78 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n->sym->mark = 1;
}
if (omp_clauses->lists[OMP_LIST_ALLOCATE])
{
for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
if (n->expr && (n->expr->ts.type != BT_INTEGER
|| n->expr->ts.kind != gfc_c_intptr_kind))
{
gfc_error ("Expected integer expression of the "
"'omp_allocator_handle_kind' kind at %L",
&n->expr->where);
break;
}
/* Check for 2 things here.
1. There is no duplication of variable in allocate clause.
2. Variable in allocate clause are also present in some
privatization clase (non-composite case). */
for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
n->sym->mark = 0;
gfc_omp_namelist *prev = NULL;
for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;)
{
if (n->sym->mark == 1)
{
gfc_warning (0, "%qs appears more than once in %<allocate%> "
"clauses at %L" , n->sym->name, &n->where);
/* We have already seen this variable so it is a duplicate.
Remove it. */
if (prev != NULL && prev->next == n)
{
prev->next = n->next;
n->next = NULL;
gfc_free_omp_namelist (n, 0);
n = prev->next;
}
continue;
}
n->sym->mark = 1;
prev = n;
n = n->next;
}
/* Non-composite constructs. */
if (code && code->op < EXEC_OMP_DO_SIMD)
{
for (list = 0; list < OMP_LIST_NUM; list++)
switch (list)
{
case OMP_LIST_PRIVATE:
case OMP_LIST_FIRSTPRIVATE:
case OMP_LIST_LASTPRIVATE:
case OMP_LIST_REDUCTION:
case OMP_LIST_REDUCTION_INSCAN:
case OMP_LIST_REDUCTION_TASK:
case OMP_LIST_IN_REDUCTION:
case OMP_LIST_TASK_REDUCTION:
case OMP_LIST_LINEAR:
for (n = omp_clauses->lists[list]; n; n = n->next)
n->sym->mark = 0;
break;
default:
break;
}
for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next)
if (n->sym->mark == 1)
gfc_error ("%qs specified in 'allocate' clause at %L but not "
"in an explicit privatization clause",
n->sym->name, &n->where);
}
}
/* OpenACC reductions. */
if (openacc)
{
@ -8438,19 +8550,20 @@ resolve_omp_do (gfc_code *code)
if (code->ext.omp_clauses)
for (list = 0; list < OMP_LIST_NUM; list++)
if (!is_simd || code->ext.omp_clauses->collapse > 1
? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE)
? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
&& list != OMP_LIST_ALLOCATE)
: (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE
&& list != OMP_LIST_LINEAR))
&& list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR))
for (n = code->ext.omp_clauses->lists[list]; n; n = n->next)
if (dovar == n->sym)
{
if (!is_simd || code->ext.omp_clauses->collapse > 1)
gfc_error ("%s iteration variable present on clause "
"other than PRIVATE or LASTPRIVATE at %L",
name, &do_code->loc);
"other than PRIVATE, LASTPRIVATE or "
"ALLOCATE at %L", name, &do_code->loc);
else
gfc_error ("%s iteration variable present on clause "
"other than PRIVATE, LASTPRIVATE or "
"other than PRIVATE, LASTPRIVATE, ALLOCATE or "
"LINEAR at %L", name, &do_code->loc);
break;
}

View File

@ -2649,6 +2649,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
}
break;
case OMP_LIST_ALLOCATE:
for (; n != NULL; n = n->next)
if (n->sym->attr.referenced)
{
tree t = gfc_trans_omp_variable (n->sym, false);
if (t != error_mark_node)
{
tree node = build_omp_clause (input_location,
OMP_CLAUSE_ALLOCATE);
OMP_CLAUSE_DECL (node) = t;
if (n->expr)
{
tree allocator_;
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, n->expr);
allocator_ = gfc_evaluate_now (se.expr, block);
OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_;
}
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
}
break;
case OMP_LIST_LINEAR:
{
gfc_expr *last_step_expr = NULL;
@ -6260,6 +6282,71 @@ gfc_split_omp_clauses (gfc_code *code,
== (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO))
&& !is_loop)
clausesa[GFC_OMP_SPLIT_DO].nowait = true;
/* Distribute allocate clause to do, parallel, distribute, teams, target
and taskloop. The code below itereates over variables in the
allocate list and checks if that available is also in any
privatization clause on those construct. If yes, then we add it
to the list of 'allocate'ed variables for that construct. If a
variable is found in none of them then we issue an error. */
if (code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE])
{
gfc_omp_namelist *alloc_nl, *priv_nl;
gfc_omp_namelist *tails[GFC_OMP_SPLIT_NUM];
for (alloc_nl = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE];
alloc_nl; alloc_nl = alloc_nl->next)
{
bool found = false;
for (int i = GFC_OMP_SPLIT_DO; i <= GFC_OMP_SPLIT_TASKLOOP; i++)
{
gfc_omp_namelist *p;
int list;
for (list = 0; list < OMP_LIST_NUM; list++)
{
switch (list)
{
case OMP_LIST_PRIVATE:
case OMP_LIST_FIRSTPRIVATE:
case OMP_LIST_LASTPRIVATE:
case OMP_LIST_REDUCTION:
case OMP_LIST_REDUCTION_INSCAN:
case OMP_LIST_REDUCTION_TASK:
case OMP_LIST_IN_REDUCTION:
case OMP_LIST_TASK_REDUCTION:
case OMP_LIST_LINEAR:
for (priv_nl = clausesa[i].lists[list]; priv_nl;
priv_nl = priv_nl->next)
if (alloc_nl->sym == priv_nl->sym)
{
found = true;
p = gfc_get_omp_namelist ();
p->sym = alloc_nl->sym;
p->expr = alloc_nl->expr;
p->where = alloc_nl->where;
if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL)
{
clausesa[i].lists[OMP_LIST_ALLOCATE] = p;
tails[i] = p;
}
else
{
tails[i]->next = p;
tails[i] = tails[i]->next;
}
}
break;
default:
break;
}
}
}
if (!found)
gfc_error ("%qs specified in 'allocate' clause at %L but not "
"in an explicit privatization clause",
alloc_nl->sym->name, &alloc_nl->where);
}
}
}
static tree

View File

@ -0,0 +1,137 @@
! { 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 bar (a, b, c)
implicit none
integer :: a
integer :: b
integer :: c
c = a + b
end
subroutine bar2 (a, b, c)
implicit none
integer :: a
integer :: b(15)
integer :: c
c = a + b(1)
end
subroutine foo(x, y)
use omp_lib_kinds
implicit none
integer :: x
integer :: z
integer, dimension(15) :: y
integer :: r
integer :: i
integer c1, c2, c3, c4
integer (kind=omp_allocator_handle_kind) :: h
common /B1/ c1, c2
common /B2/ c3, c4
r = 0
h = omp_default_mem_alloc;
!$omp parallel private(/B1/, c3, c4) allocate(/B1/, /B2/)
!$omp end parallel
!$omp parallel private(/B1/, /B2/) allocate(h:/B1/, /B2/)
!$omp end parallel
!$omp parallel private(/B1/, /B2/) allocate(omp_large_cap_mem_alloc:/B1/, c3, c4)
!$omp end parallel
!$omp parallel allocate (x) allocate (h : y) &
!$omp allocate (omp_large_cap_mem_alloc:z) firstprivate (x, y, z)
call bar2 (x, y, z);
!$omp end parallel
!$omp task private (x) firstprivate (z) allocate (omp_low_lat_mem_alloc:x,z)
call bar (0, x, z);
!$omp end task
!$omp target teams distribute parallel do private (x) firstprivate (y) &
!$omp allocate ((omp_default_mem_alloc + 0):z) allocate &
!$omp (omp_default_mem_alloc: x, y) allocate (h: r) lastprivate (z) reduction(+:r)
do i = 1, 10
call bar (0, x, z);
call bar2 (1, y, r);
end do
!$omp end target teams distribute parallel do
!$omp single private (x) allocate (omp_low_lat_mem_alloc:x)
x=1
!$omp end single
!$omp single allocate (omp_low_lat_mem_alloc:x) private (x)
!$omp end single
!$omp parallel
!$omp do allocate (x) private (x)
do i = 1, 64
x = 1;
end do
!$omp end parallel
!$omp sections private (x) allocate (omp_low_lat_mem_alloc: x)
x = 1;
!$omp section
x = 2;
!$omp section
x = 3;
!$omp end sections
!$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
call bar (r, r, r);
!$omp end taskgroup
!$omp teams private (x) firstprivate (y) allocate (h : x, y)
call bar2 (x, y, r);
!$omp end teams
!$omp taskloop lastprivate (x) reduction (+:r) allocate (h : x, r)
do i = 1, 16
call bar (0, r, r);
x = i;
end do
!$omp end taskloop
!$omp taskgroup task_reduction(+:r) allocate (omp_default_mem_alloc : r)
!$omp taskloop firstprivate (x) in_reduction (+:r) &
!$omp allocate (omp_default_mem_alloc : x, r)
do i = 1, 16
call bar (x, r, r);
end do
!$omp end taskloop
!$omp end taskgroup
!$omp taskwait
end subroutine

View File

@ -0,0 +1,45 @@
! { 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
end module
subroutine foo(x)
use omp_lib_kinds
implicit none
integer :: x
!$omp task allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
x=1
!$omp end task
!$omp parallel allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
x=2
!$omp end parallel
!$omp parallel allocate (x) shared (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
x=3
!$omp end parallel
!$omp parallel private (x) allocate (x) allocate (x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
x=4
!$omp end parallel
!$omp parallel private (x) allocate (x, x) ! { dg-warning "'x' appears more than once in 'allocate' clauses at .1." }
x=5
!$omp end parallel
!$omp parallel allocate (0: x) private(x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
x=6
!$omp end parallel
!$omp parallel private (x) allocate (0.1 : x) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." }
x=7
!$omp end parallel
end subroutine

View File

@ -0,0 +1,14 @@
! { dg-do compile }
subroutine foo(x)
implicit none
integer :: x
integer :: i
!$omp parallel do simd private (x) allocate (x) ! { dg-error "'x' specified in 'allocate' clause at .1. but not in an explicit privatization clause" }
do i = 1, 64
x = i
end do
!$omp end parallel do simd
end subroutine

View File

@ -36,8 +36,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp distribute parallel do &
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) order(concurrent)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& lastprivate (l) schedule(static, 4) order(concurrent) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll +1
end do
@ -46,8 +46,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll +1
end do
@ -55,8 +55,8 @@ subroutine foo (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp distribute simd &
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) &
!$omp& order(concurrent)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& order(concurrent) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll +1
end do
@ -81,8 +81,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp distribute parallel do &
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) copyin(t)
! FIXME/TODO: allocate (p)
!$omp& lastprivate (l) schedule(static, 4) copyin(t) &
!$omp& allocate (p)
do i = 1, 64
ll = ll +1
end do
@ -90,8 +90,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp distribute parallel do &
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) order(concurrent)
! FIXME/TODO: allocate (p)
!$omp& lastprivate (l) schedule(static, 4) order(concurrent) &
!$omp& allocate (p)
do i = 1, 64
ll = ll +1
end do
@ -100,8 +100,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) copyin(t)
! FIXME/TODO: allocate (f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) copyin(t) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
@ -110,8 +110,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) if(simd: i1) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) nontemporal(ntm) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
@ -119,8 +119,8 @@ subroutine baz (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp distribute simd &
!$omp& private (p) firstprivate (f) collapse(1) dist_schedule(static, 16) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) reduction(+:r) if(i1) nontemporal(ntm) &
!$omp& order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
@ -140,8 +140,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp do simd &
!$omp& private (p) firstprivate (f) lastprivate (l) linear (ll:1) reduction(+:r) schedule(static, 4) collapse(1) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) if(i1) order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
@ -149,16 +149,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel do &
!$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
!$omp& proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1)
! FIXME/TODO: allocate (f)
!$omp& proc_bind(spread) lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
!$omp parallel do &
!$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
!$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
@ -166,16 +166,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel do simd &
!$omp& private (p) firstprivate (f) if (i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
!$omp& proc_bind(spread) lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) nontemporal(ntm) order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
!$omp parallel sections &
!$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
!$omp& proc_bind(spread) lastprivate (l)
! FIXME/TODO: allocate (f)
!$omp& proc_bind(spread) lastprivate (l) &
!$omp& allocate (f)
!$omp section
block; end block
!$omp section
@ -185,16 +185,16 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp target parallel &
!$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& depend(inout: dd(0)) in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& depend(inout: dd(0)) in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
!$omp end target parallel nowait
!$omp target parallel do &
!$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) linear (ll:1) ordered schedule(static, 4) collapse(1) depend(inout: dd(0)) &
!$omp& in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll + 1
end do
@ -204,8 +204,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) depend(inout: dd(0)) order(concurrent) &
!$omp& in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll + 1
end do
@ -216,8 +216,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& if (parallel: i2) default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) linear (ll:1) schedule(static, 4) collapse(1) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) order(concurrent) &
!$omp& in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll + 1
end do
@ -226,15 +226,15 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp target teams &
!$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& shared(s) default(shared) reduction(+:r) num_teams(nte - 1:nte) thread_limit(tl) depend(inout: dd(0)) &
!$omp& in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
!$omp end target teams nowait
!$omp target teams distribute &
!$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) order(concurrent) &
!$omp& collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& collapse(1) dist_schedule(static, 16) depend(inout: dd(0)) in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
end do
!$omp end target teams distribute nowait
@ -245,8 +245,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) depend(inout: dd(0)) order(concurrent) &
!$omp& in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll + 1
end do
@ -259,8 +259,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) order(concurrent) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) if (simd: i3) &
!$omp& in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll + 1
end do
@ -271,8 +271,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
!$omp& collapse(1) dist_schedule(static, 16) order(concurrent) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) depend(inout: dd(0)) nontemporal(ntm) &
!$omp& in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll + 1
end do
@ -282,34 +282,34 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& device(d) map (tofrom: m) if (target: i1) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& safelen(8) simdlen(4) lastprivate (l) linear(ll: 1) aligned(q: 32) reduction(+:r) &
!$omp& depend(inout: dd(0)) nontemporal(ntm) if(simd:i3) order(concurrent) &
!$omp& in_reduction(+:r2)
! FIXME/TODO: allocate (omp_default_mem_alloc:f)
!$omp& in_reduction(+:r2) &
!$omp& allocate (omp_default_mem_alloc:f)
do i = 1, 64
ll = ll + 1
end do
!$omp end target simd nowait
!$omp taskgroup task_reduction(+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction(+:r2) &
!$omp& allocate (r2)
!$omp taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
!$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) &
!$omp& order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
!$omp end taskgroup
!$omp taskgroup task_reduction(+:r)
! FIXME/TODO: allocate (r)
!$omp taskgroup task_reduction(+:r) &
!$omp& allocate (r)
!$omp taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied if(i1) &
!$omp& final(fi) mergeable nogroup priority (pp) &
!$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) in_reduction(+:r) nontemporal(ntm) &
!$omp& order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
@ -319,8 +319,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) if(taskloop: i1) &
!$omp& final(fi) priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(+:r) if (simd: i3) nontemporal(ntm) &
!$omp& order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll + 1
end do
@ -328,8 +328,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp target depend(inout: dd(0)) in_reduction(+:r2)
!$omp teams distribute &
!$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) &
!$omp& collapse(1) dist_schedule(static, 16) order(concurrent)
! FIXME/TODO: allocate (omp_default_mem_alloc: f)
!$omp& collapse(1) dist_schedule(static, 16) order(concurrent) &
!$omp& allocate (omp_default_mem_alloc: f)
do i = 1, 64
end do
!$omp end target nowait
@ -339,8 +339,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
!$omp& collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) order(concurrent)
! FIXME/TODO: allocate (omp_default_mem_alloc: f)
!$omp& lastprivate (l) schedule(static, 4) order(concurrent) &
!$omp& allocate (omp_default_mem_alloc: f)
do i = 1, 64
ll = ll +1
end do
@ -352,8 +352,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) order(concurrent) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm)
! FIXME/TODO: allocate (omp_default_mem_alloc: f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) &
!$omp& allocate (omp_default_mem_alloc: f)
do i = 1, 64
ll = ll +1
end do
@ -363,8 +363,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp teams distribute simd &
!$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
!$omp& collapse(1) dist_schedule(static, 16) order(concurrent) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm)
! FIXME/TODO: allocate (omp_default_mem_alloc: f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) &
!$omp& allocate (omp_default_mem_alloc: f)
do i = 1, 64
ll = ll +1
end do
@ -374,8 +374,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) &
!$omp& collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) copyin(t)
! FIXME/TODO: allocate (f)
!$omp& lastprivate (l) schedule(static, 4) copyin(t) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -384,8 +384,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
!$omp& collapse(1) dist_schedule(static, 16) order(concurrent) &
!$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4)
! FIXME/TODO: allocate (f)
!$omp& lastprivate (l) schedule(static, 4) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -395,8 +395,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t)
! FIXME/TODO: allocate (f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) copyin(t) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -406,8 +406,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& collapse(1) dist_schedule(static, 16) &
!$omp& if (parallel: i2) num_threads (nth) proc_bind(spread) &
!$omp& lastprivate (l) schedule(static, 4) order(concurrent) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm)
! FIXME/TODO: allocate (f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) if (simd: i3) nontemporal(ntm) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -415,68 +415,68 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp teams distribute simd &
!$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) &
!$omp& collapse(1) dist_schedule(static, 16) order(concurrent) &
!$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm)
! FIXME/TODO: allocate(f)
!$omp& safelen(8) simdlen(4) aligned(q: 32) if(i3) nontemporal(ntm) &
!$omp& allocate(f)
do i = 1, 64
ll = ll +1
end do
!$omp parallel master &
!$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) &
!$omp& num_threads (nth) proc_bind(spread) copyin(t)
! FIXME/TODO: allocate (f)
!$omp& num_threads (nth) proc_bind(spread) copyin(t) &
!$omp& allocate (f)
!$omp end parallel master
!$omp parallel masked &
!$omp& private (p) firstprivate (f) if (parallel: i2) default(shared) shared(s) reduction(+:r) &
!$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d)
! FIXME/TODO: allocate (f)
!$omp& num_threads (nth) proc_bind(spread) copyin(t) filter (d) &
!$omp& allocate (f)
!$omp end parallel masked
!$omp taskgroup task_reduction (+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction (+:r2) &
!$omp& allocate (r2)
!$omp master taskloop &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) final(fi) mergeable priority (pp) &
!$omp& reduction(default, +:r) in_reduction(+:r2)
! FIXME/TODO: allocate (f)
!$omp& reduction(default, +:r) in_reduction(+:r2) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
!$omp end taskgroup
!$omp taskgroup task_reduction (+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction (+:r2) &
!$omp& allocate (r2)
!$omp masked taskloop &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d)
! FIXME/TODO: allocate (f)
!$omp& if(taskloop: i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
!$omp end taskgroup
!$omp taskgroup task_reduction (+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction (+:r2) &
!$omp& allocate (r2)
!$omp master taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
!$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) &
!$omp& order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
!$omp end taskgroup
!$omp taskgroup task_reduction (+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction (+:r2) &
!$omp& allocate (r2)
!$omp masked taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
!$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) in_reduction(+:r2) nontemporal(ntm) &
!$omp& order(concurrent) filter (d)
! FIXME/TODO: allocate (f)
!$omp& order(concurrent) filter (d) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -485,8 +485,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel master taskloop &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) final(fi) mergeable priority (pp) &
!$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t)
! FIXME/TODO: allocate (f)
!$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -494,8 +494,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel masked taskloop &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) final(fi) mergeable priority (pp) &
!$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d)
! FIXME/TODO: allocate (f)
!$omp& reduction(default, +:r) if (parallel: i2) num_threads (nth) proc_bind(spread) copyin(t) filter (d) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -504,8 +504,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
!$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) &
!$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -514,14 +514,14 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) grainsize (g) collapse(1) untied &
!$omp& if(taskloop: i1) if(simd: i2) final(fi) mergeable priority (pp) &
!$omp& safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) nontemporal(ntm) if (parallel: i2) &
!$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d)
! FIXME/TODO: allocate (f)
!$omp& num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
!$omp taskgroup task_reduction (+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction (+:r2) &
!$omp& allocate (r2)
!$omp master taskloop &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) &
!$omp& untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2)
@ -530,8 +530,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
end do
!$omp end taskgroup
!$omp taskgroup task_reduction (+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction (+:r2) &
!$omp& allocate (r2)
!$omp masked taskloop &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) &
!$omp& untied if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) in_reduction(+:r2) filter (d)
@ -540,25 +540,25 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
end do
!$omp end taskgroup
!$omp taskgroup task_reduction (+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction (+:r2) &
!$omp& allocate (r2)
!$omp master taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) &
!$omp& final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) &
!$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
!$omp end taskgroup
!$omp taskgroup task_reduction (+:r2)
! FIXME/TODO: allocate (r2)
!$omp taskgroup task_reduction (+:r2) &
!$omp& allocate (r2)
!$omp masked taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied &
!$omp& if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) &
!$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d)
! FIXME/TODO: allocate (f)
!$omp& in_reduction(+:r2) nontemporal(ntm) order(concurrent) filter (d) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -566,8 +566,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel master taskloop &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied &
!$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t)
! FIXME/TODO: allocate (f)
!$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) copyin(t) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -575,8 +575,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel masked taskloop &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied &
!$omp& if(i1) final(fi) mergeable priority (pp) reduction(default, +:r) num_threads (nth) proc_bind(spread) &
!$omp& copyin(t) filter (d)
! FIXME/TODO: allocate (f)
!$omp& copyin(t) filter (d) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -584,8 +584,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel master taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied &
!$omp& if(i1) final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) &
!$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread)copyin(t) order(concurrent) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -593,8 +593,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel masked taskloop simd &
!$omp& private (p) firstprivate (f) lastprivate (l) shared (s) default(shared) num_tasks (nta) collapse(1) untied if(i1) &
!$omp& final(fi) mergeable priority (pp) safelen(8) simdlen(4) linear(ll: 1) aligned(q: 32) reduction(default, +:r) &
!$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d)
! FIXME/TODO: allocate (f)
!$omp& nontemporal(ntm) num_threads (nth) proc_bind(spread) copyin(t) order(concurrent) filter (d) &
!$omp& allocate (f)
do i = 1, 64
ll = ll +1
end do
@ -607,31 +607,31 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp parallel loop &
!$omp& private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
!$omp& proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2)
! FIXME/TODO: allocate (f)
!$omp& proc_bind(spread) lastprivate (l) collapse(1) bind(parallel) order(concurrent) if (parallel: i2) &
!$omp& allocate (f)
do l = 1, 64
ll = ll + 1
end do
!$omp parallel loop &
!$omp& private (p) firstprivate (f) default(shared) shared(s) copyin(t) reduction(+:r) num_threads (nth) &
!$omp& proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2)
! FIXME/TODO: allocate (f)
!$omp& proc_bind(spread) lastprivate (l) collapse(1) if (parallel: i2) &
!$omp& allocate (f)
do l = 1, 64
ll = ll + 1
end do
!$omp teams loop &
!$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) &
!$omp& collapse(1) lastprivate (l) bind(teams)
! FIXME/TODO: allocate (f)
!$omp& collapse(1) lastprivate (l) bind(teams) &
!$omp& allocate (f)
do l = 1, 64
end do
!$omp teams loop &
!$omp& private(p) firstprivate (f) shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) &
!$omp& collapse(1) lastprivate (l) order(concurrent)
! FIXME/TODO: allocate (f)
!$omp& collapse(1) lastprivate (l) order(concurrent) &
!$omp& allocate (f)
do l = 1, 64
end do
@ -639,8 +639,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& default(shared) shared(s) reduction(+:r) num_threads (nth) proc_bind(spread) &
!$omp& depend(inout: dd(0)) lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) &
!$omp& if (target: i1) if (parallel: i2)
! FIXME/TODO: allocate (omp_default_mem_alloc: f)
!$omp& if (target: i1) if (parallel: i2) &
!$omp& allocate (omp_default_mem_alloc: f)
do l = 1, 64
end do
!$omp end target parallel loop nowait
@ -648,8 +648,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp target teams loop &
!$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& shared(s) default(shared) reduction(+:r) num_teams(nte-1:nte) thread_limit(tl) depend(inout: dd(0)) &
!$omp& lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1)
! FIXME/TODO: allocate (omp_default_mem_alloc: f)
!$omp& lastprivate (l) bind(teams) collapse(1) in_reduction(+:r2) if (target: i1) &
!$omp& allocate (omp_default_mem_alloc: f)
do l = 1, 64
end do
!$omp end target teams loop nowait
@ -657,8 +657,8 @@ subroutine bar (d, m, i1, i2, i3, p, idp, s, nte, tl, nth, g, nta, fi, pp, q, dd
!$omp target teams loop &
!$omp& device(d) map (tofrom: m) private (p) firstprivate (f) defaultmap(tofrom: scalar) is_device_ptr (idp) &
!$omp& shared(s) default(shared) reduction(+:r) num_teams(nte) thread_limit(tl) depend(inout: dd(0)) &
!$omp& lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1)
! FIXME/TODO: allocate (omp_default_mem_alloc: f)
!$omp& lastprivate (l) order(concurrent) collapse(1) in_reduction(+:r2) if (target: i1) &
!$omp& allocate (omp_default_mem_alloc: f)
do l = 1, 64
end do
!$omp end target teams loop nowait

View File

@ -24,7 +24,7 @@ subroutine collapse1
end do
!$omp parallel do collapse(2) shared(j)
do i = 1, 3
do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
do j = 4, 6 ! { dg-error "iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
end do
end do
!$omp parallel do collapse(2)

View File

@ -45,17 +45,17 @@ do i = 1, 5
end do
!$omp parallel do firstprivate(i)
do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
do i = 1, 5 ! { dg-error "PARALLEL DO iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
x(i) = 42
end do
!$omp parallel do simd firstprivate(i)
do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or LINEAR" }
do i = 1, 5 ! { dg-error "PARALLEL DO SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE, ALLOCATE or LINEAR" }
x(i) = 42
end do
!$omp simd linear(i) collapse(2)
do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE or LASTPRIVATE" }
do i = 1, 5 ! { dg-error "SIMD iteration variable present on clause other than PRIVATE, LASTPRIVATE or ALLOCATE" }
do j = 1, 2
y(j, i) = 52
end do

View File

@ -219,7 +219,7 @@ The OpenMP 4.5 specification is fully supported.
@tab Y @tab Some are only stubs
@item Memory management routines @tab Y @tab
@item @code{allocate} directive @tab N @tab
@item @code{allocate} clause @tab P @tab initial support in C/C++ only
@item @code{allocate} clause @tab P @tab initial support
@item @code{use_device_addr} clause on @code{target data} @tab Y @tab
@item @code{ancestor} modifier on @code{device} clause
@tab P @tab Reverse offload unsupported

View File

@ -0,0 +1,7 @@
#include <stdint.h>
int
is_64bit_aligned_ (uintptr_t a)
{
return ( (a & 0x3f) == 0);
}

View File

@ -0,0 +1,333 @@
! { dg-do run }
! { dg-additional-sources allocate-1.c }
! { dg-prune-output "command-line option '-fintrinsic-modules-path=.*' is valid for Fortran but not for C" }
module m
use omp_lib
use iso_c_binding
implicit none
interface
integer(c_int) function is_64bit_aligned (a) bind(C)
import :: c_int
integer :: a
end
end interface
end module m
subroutine foo (x, p, q, px, h, fl)
use omp_lib
use iso_c_binding
integer :: x
integer, dimension(4) :: p
integer, dimension(4) :: q
integer :: px
integer (kind=omp_allocator_handle_kind) :: h
integer :: fl
integer :: y
integer :: r, i, i1, i2, i3, i4, i5
integer :: l, l3, l4, l5, l6
integer :: n, n1, n2, n3, n4
integer :: j2, j3, j4
integer, dimension(4) :: l2
integer, dimension(4) :: r2
integer, target :: xo
integer, target :: yo
integer, dimension(x) :: v
integer, dimension(x) :: w
type s_type
integer :: a
integer :: b
end type
type (s_type) :: s
s%a = 27
s%b = 29
y = 0
r = 0
n = 8
n2 = 9
n3 = 10
n4 = 11
xo = x
yo = y
do i = 1, 4
r2(i) = 0;
end do
do i = 1, 4
p(i) = 0;
end do
do i = 1, 4
q(i) = 0;
end do
do i = 1, x
w(i) = i
end do
!$omp parallel private (y, v) firstprivate (x) allocate (x, y, v)
if (x /= 42) then
stop 1
end if
v(1) = 7
if ( (and(fl, 2) /= 0) .and. &
((is_64bit_aligned(x) == 0) .or. &
(is_64bit_aligned(y) == 0) .or. &
(is_64bit_aligned(v(1)) == 0))) then
stop 2
end if
!$omp barrier
y = 1;
x = x + 1
v(1) = 7
v(41) = 8
!$omp barrier
if (x /= 43 .or. y /= 1) then
stop 3
end if
if (v(1) /= 7 .or. v(41) /= 8) then
stop 4
end if
!$omp end parallel
!$omp teams
!$omp parallel private (y) firstprivate (x, w) allocate (h: x, y, w)
if (x /= 42 .or. w(17) /= 17 .or. w(41) /= 41) then
stop 5
end if
!$omp barrier
y = 1;
x = x + 1
w(19) = w(19) + 1
!$omp barrier
if (x /= 43 .or. y /= 1 .or. w(19) /= 20) then
stop 6
end if
if ( (and(fl, 1) /= 0) .and. &
((is_64bit_aligned(x) == 0) .or. &
(is_64bit_aligned(y) == 0) .or. &
(is_64bit_aligned(w(1)) == 0))) then
stop 7
end if
!$omp end parallel
!$omp end teams
!$omp parallel do private (y) firstprivate (x) reduction(+: r) allocate (h: x, y, r, l, n) lastprivate (l) linear (n: 16)
do i = 0, 63
if (x /= 42) then
stop 8
end if
y = 1;
l = i;
n = n + y + 15;
r = r + i;
if ( (and(fl, 1) /= 0) .and. &
((is_64bit_aligned(x) == 0) .or. &
(is_64bit_aligned(y) == 0) .or. &
(is_64bit_aligned(r) == 0) .or. &
(is_64bit_aligned(l) == 0) .or. &
(is_64bit_aligned(n) == 0))) then
stop 9
end if
end do
!$omp end parallel do
!$omp parallel
!$omp do lastprivate (l2) private (i1) allocate (h: l2, l3, i1) lastprivate (conditional: l3)
do i1 = 0, 63
l2(1) = i1
l2(2) = i1 + 1
l2(3) = i1 + 2
l2(4) = i1 + 3
if (i1 < 37) then
l3 = i1
end if
if ( (and(fl, 1) /= 0) .and. &
((is_64bit_aligned(l2(1)) == 0) .or. &
(is_64bit_aligned(l3) == 0) .or. &
(is_64bit_aligned(i1) == 0))) then
stop 10
end if
end do
!$omp do collapse(2) lastprivate(l4, i2, j2) linear (n2:17) allocate (h: n2, l4, i2, j2)
do i2 = 3, 4
do j2 = 17, 22, 2
n2 = n2 + 17
l4 = i2 * 31 + j2
if ( (and(fl, 1) /= 0) .and. &
((is_64bit_aligned(l4) == 0) .or. &
(is_64bit_aligned(n2) == 0) .or. &
(is_64bit_aligned(i2) == 0) .or. &
(is_64bit_aligned(j2) == 0))) then
stop 11
end if
end do
end do
!$omp do collapse(2) lastprivate(l5, i3, j3) linear (n3:17) schedule (static, 3) allocate (n3, l5, i3, j3)
do i3 = 3, 4
do j3 = 17, 22, 2
n3 = n3 + 17
l5 = i3 * 31 + j3
if ( (and(fl, 2) /= 0) .and. &
((is_64bit_aligned(l5) == 0) .or. &
(is_64bit_aligned(n3) == 0) .or. &
(is_64bit_aligned(i3) == 0) .or. &
(is_64bit_aligned(j3) == 0))) then
stop 12
end if
end do
end do
!$omp do collapse(2) lastprivate(l6, i4, j4) linear (n4:17) schedule (dynamic) allocate (h: n4, l6, i4, j4)
do i4 = 3, 4
do j4 = 17, 22,2
n4 = n4 + 17;
l6 = i4 * 31 + j4;
if ( (and(fl, 1) /= 0) .and. &
((is_64bit_aligned(l6) == 0) .or. &
(is_64bit_aligned(n4) == 0) .or. &
(is_64bit_aligned(i4) == 0) .or. &
(is_64bit_aligned(j4) == 0))) then
stop 13
end if
end do
end do
!$omp do lastprivate (i5) allocate (i5)
do i5 = 1, 17, 3
if ( (and(fl, 2) /= 0) .and. &
(is_64bit_aligned(i5) == 0)) then
stop 14
end if
end do
!$omp do reduction(+:p, q, r2) allocate(h: p, q, r2)
do i = 0, 31
p(3) = p(3) + i;
p(4) = p(4) + (2 * i)
q(1) = q(1) + (3 * i)
q(3) = q(3) + (4 * i)
r2(1) = r2(1) + (5 * i)
r2(4) = r2(4) + (6 * i)
if ( (and(fl, 1) /= 0) .and. &
((is_64bit_aligned(q(1)) == 0) .or. &
(is_64bit_aligned(p(1)) == 0) .or. &
(is_64bit_aligned(r2(1)) == 0) )) then
stop 15
end if
end do
!$omp task private(y) firstprivate(x) allocate(x, y)
if (x /= 42) then
stop 16
end if
if ( (and(fl, 2) /= 0) .and. &
((is_64bit_aligned(x) == 0) .or. &
(is_64bit_aligned(y) == 0) )) then
stop 17
end if
!$omp end task
!$omp task private(y) firstprivate(x) allocate(h: x, y)
if (x /= 42) then
stop 16
end if
if ( (and(fl, 1) /= 0) .and. &
((is_64bit_aligned(x) == 0) .or. &
(is_64bit_aligned(y) == 0) )) then
stop 17
end if
!$omp end task
!$omp task private(y) firstprivate(s) allocate(s, y)
if (s%a /= 27 .or. s%b /= 29) then
stop 18
end if
if ( (and(fl, 2) /= 0) .and. &
((is_64bit_aligned(s%a) == 0) .or. &
(is_64bit_aligned(y) == 0) )) then
stop 19
end if
!$omp end task
!$omp task private(y) firstprivate(s) allocate(h: s, y)
if (s%a /= 27 .or. s%b /= 29) then
stop 18
end if
if ( (and(fl, 1) /= 0) .and. &
((is_64bit_aligned(s%a) == 0) .or. &
(is_64bit_aligned(y) == 0) )) then
stop 19
end if
!$omp end task
!$omp end parallel
if (r /= ((64 * 63) / 2) .or. l /= 63 .or. n /= (8 + 16 * 64)) then
stop 20
end if
if (l2(1) /= 63 .or. l2(2) /= 64 .or. l2(3) /= 65 .or. l2(4) /= 66 .or. l3 /= 36) then
stop 21
end if
if (i2 /= 5 .or. j2 /= 23 .or. n2 /= (9 + (17 * 6)) .or. l4 /= (4 * 31 + 21)) then
stop 22
end if
if (i3 /= 5 .or. j3 /= 23 .or. n3 /= (10 + (17 * 6)) .or. l5 /= (4 * 31 + 21)) then
stop 23
end if
if (i4 /= 5 .or. j4 /= 23 .or. n4 /= (11 + (17 * 6)) .or. l6 /= (4 * 31 + 21)) then
stop 24
end if
if (i5 /= 19) then
stop 24
end if
if (p(3) /= ((32 * 31) / 2) .or. p(4) /= (2 * p(3)) &
.or. q(1) /= (3 * p(3)) .or. q(3) /= (4 * p(3)) &
.or. r2(1) /= (5 * p(3)) .or. r2(4) /= (6 * p(3))) then
stop 25
end if
end subroutine
program main
use omp_lib
integer, dimension(4) :: p
integer, dimension(4) :: q
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
call omp_set_default_allocator (omp_default_mem_alloc);
call foo (42, p, q, 2, a, 0);
call foo (42, p, q, 2, omp_default_mem_alloc, 0);
call foo (42, p, q, 2, a, 1);
call omp_set_default_allocator (a);
call foo (42, p, q, 2, omp_null_allocator, 3);
call foo (42, p, q, 2, omp_default_mem_alloc, 2);
call omp_destroy_allocator (a);
end