procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

OpenMP/Fortran: Parsing support for 'uses_allocators'

Browse source 
The 'uses_allocators' clause to the 'target' construct accepts predefined
allocators and can also be used to define a new allocator for a target region.
As predefined allocators in GCC do not require special handling, those can and
are ignored after parsing, such that this feature now works. On the other hand,
defining a new allocator will fail for now with a 'sorry, unimplemented'.

Note that both the OpenMP 5.0/5.1 and 5.2 syntax for uses_allocators
is supported by this commit.

2023-07-17  Tobias Burnus  <tobias@codesoucery.com>
	    Chung-Lin Tang  <cltang@codesourcery.com>

gcc/fortran/ChangeLog:

	* dump-parse-tree.cc (show_omp_namelist, show_omp_clauses): Dump
	uses_allocators clause.
	* gfortran.h (gfc_free_omp_namelist): Add memspace_sym to u union
	and traits_sym to u2 union.
	(OMP_LIST_USES_ALLOCATORS): New enum value.
	(gfc_free_omp_namelist): Add 'bool free_mem_traits_space' arg.
	* match.cc (gfc_free_omp_namelist): Likewise.
	* openmp.cc (gfc_free_omp_clauses, gfc_match_omp_variable_list,
	gfc_match_omp_to_link, gfc_match_omp_doacross_sink,
	gfc_match_omp_clause_reduction, gfc_match_omp_allocate,
	gfc_match_omp_flush): Update call.
	(gfc_match_omp_clauses): Likewise. Parse uses_allocators clause.
	(gfc_match_omp_clause_uses_allocators): New.
	(enum omp_mask2): Add new OMP_CLAUSE_USES_ALLOCATORS.
	(OMP_TARGET_CLAUSES): Accept it.
	(resolve_omp_clauses): Resolve uses_allocators clause
	* st.cc (gfc_free_statement): Update gfc_free_omp_namelist call.
	* trans-openmp.cc (gfc_trans_omp_clauses): Handle
	OMP_LIST_USES_ALLOCATORS; fail with sorry unless predefined allocator.
	(gfc_split_omp_clauses): Handle uses_allocators.

libgomp/ChangeLog:

	* testsuite/libgomp.fortran/uses_allocators_1.f90: New test.
	* testsuite/libgomp.fortran/uses_allocators_2.f90: New test.

Co-authored-by: Chung-Lin Tang <cltang@codesourcery.com>
This commit is contained in:
Tobias Burnus 2023-07-17 15:13:44 +02:00
parent 3b9cd125cf
commit 89d0f082b3
8 changed files with 491 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
gcc/fortran/dump-parse-tree.cc
View file

@ -1497,6 +1497,29 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
case OMP_LINEAR_UVAL: fputs ("uval(", dumpfile); break;
default: break;
}
else if (list_type == OMP_LIST_USES_ALLOCATORS)
{
if (n->u.memspace_sym)
{
fputs ("memspace(", dumpfile);
fputs (n->sym->name, dumpfile);
fputc (')', dumpfile);
}
if (n->u.memspace_sym && n->u2.traits_sym)
fputc (',', dumpfile);
if (n->u2.traits_sym)
{
fputs ("traits(", dumpfile);
fputs (n->u2.traits_sym->name, dumpfile);
fputc (')', dumpfile);
}
if (n->u.memspace_sym || n->u2.traits_sym)
fputc (':', dumpfile);
fputs (n->sym->name, dumpfile);
if (n->next)
fputs (", ", dumpfile);
continue;
}
fprintf (dumpfile, "%s", n->sym ? n->sym->name : "omp_all_memory");
if (list_type == OMP_LIST_LINEAR && n->u.linear.op != OMP_LINEAR_DEFAULT)
fputc (')', dumpfile);
@ -1799,6 +1822,7 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses)
case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break;
case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break;
case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break;
case OMP_LIST_USES_ALLOCATORS: type = "USES_ALLOCATORS"; break;
default:
gcc_unreachable ();
}

5
gcc/fortran/gfortran.h
View file

@ -1368,6 +1368,7 @@ typedef struct gfc_omp_namelist
bool old_modifier;
} linear;
struct gfc_common_head *common;
struct gfc_symbol *memspace_sym;
bool lastprivate_conditional;
bool present_modifier;
} u;
@ -1376,6 +1377,7 @@ typedef struct gfc_omp_namelist
struct gfc_omp_namelist_udr *udr;
gfc_namespace *ns;
gfc_expr *allocator;
struct gfc_symbol *traits_sym;
} u2;
struct gfc_omp_namelist *next;
locus where;
@ -1419,6 +1421,7 @@ enum
OMP_LIST_ALLOCATE,
OMP_LIST_HAS_DEVICE_ADDR,
OMP_LIST_ENTER,
OMP_LIST_USES_ALLOCATORS,
OMP_LIST_NUM /* Must be the last. */
};
@ -3600,7 +3603,7 @@ void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
void gfc_free_alloc_list (gfc_alloc *);
void gfc_free_namelist (gfc_namelist *);
void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool);
void gfc_free_omp_namelist (gfc_omp_namelist *, bool, bool, bool);
void gfc_free_equiv (gfc_equiv *);
void gfc_free_equiv_until (gfc_equiv *, gfc_equiv *);
void gfc_free_data (gfc_data *);

7
gcc/fortran/match.cc
View file

@ -5537,7 +5537,8 @@ gfc_free_namelist (gfc_namelist *name)
void
gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
bool free_align_allocator)
bool free_align_allocator,
bool free_mem_traits_space)
{
gfc_omp_namelist *n;
@ -5546,10 +5547,14 @@ gfc_free_omp_namelist (gfc_omp_namelist *name, bool free_ns,
gfc_free_expr (name->expr);
if (free_align_allocator)
gfc_free_expr (name->u.align);
else if (free_mem_traits_space)
{ } /* name->u.memspace_sym: shall not call gfc_free_symbol here. */
if (free_ns)
gfc_free_namespace (name->u2.ns);
else if (free_align_allocator)
gfc_free_expr (name->u2.allocator);
else if (free_mem_traits_space)
{ } /* name->u2.traits_sym: shall not call gfc_free_symbol here. */
else if (name->u2.udr)
{
if (name->u2.udr->combiner)

194
gcc/fortran/openmp.cc
View file

@ -188,7 +188,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
for (i = 0; i < OMP_LIST_NUM; i++)
gfc_free_omp_namelist (c->lists[i],
i == OMP_LIST_AFFINITY || i == OMP_LIST_DEPEND,
i == OMP_LIST_ALLOCATE);
i == OMP_LIST_ALLOCATE,
i == OMP_LIST_USES_ALLOCATORS);
gfc_free_expr_list (c->wait_list);
gfc_free_expr_list (c->tile_list);
free (CONST_CAST (char *, c->critical_name));
@ -553,7 +554,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
gfc_free_omp_namelist (head, false, false);
gfc_free_omp_namelist (head, false, false, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@ -643,7 +644,7 @@ syntax:
gfc_error ("Syntax error in OpenMP variable list at %C");
cleanup:
gfc_free_omp_namelist (head, false, false);
gfc_free_omp_namelist (head, false, false, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@ -752,7 +753,7 @@ syntax:
gfc_error ("Syntax error in OpenMP SINK dependence-type list at %C");
cleanup:
gfc_free_omp_namelist (head, false, false);
gfc_free_omp_namelist (head, false, false, false);
gfc_current_locus = old_loc;
return MATCH_ERROR;
}
@ -1091,6 +1092,7 @@ enum omp_mask2
OMP_CLAUSE_ENTER, /* OpenMP 5.2 */
OMP_CLAUSE_DOACROSS, /* OpenMP 5.2 */
OMP_CLAUSE_ASSUMPTIONS, /* OpenMP 5.1. */
OMP_CLAUSE_USES_ALLOCATORS, /* OpenMP 5.0 */
/* This must come last. */
OMP_MASK2_LAST
};
@ -1502,7 +1504,7 @@ gfc_match_omp_clause_reduction (char pc, gfc_omp_clauses *c, bool openacc,
*head = NULL;
gfc_error_now ("!$OMP DECLARE REDUCTION %s not found at %L",
buffer, &old_loc);
gfc_free_omp_namelist (n, false, false);
gfc_free_omp_namelist (n, false, false, false);
}
else
for (n = *head; n; n = n->next)
@ -1697,6 +1699,106 @@ omp_verify_merge_absent_contains (gfc_statement st, gfc_omp_assumptions *check,
return MATCH_YES;
}
/* OpenMP 5.0
uses_allocators ( allocator-list )
allocator:
predefined-allocator
variable ( traits-array )
OpenMP 5.2:
uses_allocators ( [modifier-list :] allocator-list )
allocator:
variable or predefined-allocator
modifier:
traits ( traits-array )
memspace ( mem-space-handle ) */
static match
gfc_match_omp_clause_uses_allocators (gfc_omp_clauses *c)
{
gfc_symbol *memspace_sym = NULL;
gfc_symbol *traits_sym = NULL;
gfc_omp_namelist *head = NULL;
gfc_omp_namelist *p, *tail, **list;
int ntraits, nmemspace;
bool has_modifiers;
locus old_loc, cur_loc;
gfc_gobble_whitespace ();
old_loc = gfc_current_locus;
ntraits = nmemspace = 0;
do
{
cur_loc = gfc_current_locus;
if (gfc_match ("traits ( %S ) ", &traits_sym) == MATCH_YES)
ntraits++;
else if (gfc_match ("memspace ( %S ) ", &memspace_sym) == MATCH_YES)
nmemspace++;
if (ntraits > 1 || nmemspace > 1)
{
gfc_error ("Duplicate %s modifier at %L in USES_ALLOCATORS clause",
ntraits > 1 ? "TRAITS" : "MEMSPACE", &cur_loc);
return MATCH_ERROR;
}
if (gfc_match (", ") == MATCH_YES)
continue;
if (gfc_match (": ") != MATCH_YES)
{
/* Assume no modifier. */
memspace_sym = traits_sym = NULL;
gfc_current_locus = old_loc;
break;
}
break;
} while (true);
has_modifiers = traits_sym != NULL || memspace_sym != NULL;
do
{
p = gfc_get_omp_namelist ();
p->where = gfc_current_locus;
if (head == NULL)
head = tail = p;
else
{
tail->next = p;
tail = tail->next;
}
if (gfc_match ("%S ", &p->sym) != MATCH_YES)
goto error;
if (!has_modifiers)
gfc_match ("( %S ) ", &p->u2.traits_sym);
else if (gfc_peek_ascii_char () == '(')
{
gfc_error ("Unexpected %<(%> at %C");
goto error;
}
else
{
p->u.memspace_sym = memspace_sym;
p->u2.traits_sym = traits_sym;
}
if (gfc_match (", ") == MATCH_YES)
continue;
if (gfc_match (") ") == MATCH_YES)
break;
goto error;
} while (true);
list = &c->lists[OMP_LIST_USES_ALLOCATORS];
while (*list)
list = &(*list)->next;
*list = head;
return MATCH_YES;
error:
gfc_free_omp_namelist (head, false, false, true);
return MATCH_ERROR;
}
/* Match with duplicate check. Matches 'name'. If expr != NULL, it
then matches '(expr)', otherwise, if open_parens is true,
@ -1820,7 +1922,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
if (end_colon && gfc_match (" %e )", &alignment) != MATCH_YES)
{
gfc_free_omp_namelist (*head, false, false);
gfc_free_omp_namelist (*head, false, false, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@ -2763,7 +2865,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
end_colon = true;
else if (gfc_match (" )") != MATCH_YES)
{
gfc_free_omp_namelist (*head, false, false);
gfc_free_omp_namelist (*head, false, false, false);
gfc_current_locus = old_loc;
*head = NULL;
break;
@ -2774,7 +2876,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
{
if (gfc_match (" %e )", &step) != MATCH_YES)
{
gfc_free_omp_namelist (*head, false, false);
gfc_free_omp_namelist (*head, false, false, false);
gfc_current_locus = old_loc;
*head = NULL;
goto error;
@ -2871,7 +2973,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
}
if (has_error)
{
gfc_free_omp_namelist (*head, false, false);
gfc_free_omp_namelist (*head, false, false, false);
*head = NULL;
goto error;
}
@ -3561,6 +3663,13 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask,
("use_device_addr (", &c->lists[OMP_LIST_USE_DEVICE_ADDR],
false, NULL, NULL, true) == MATCH_YES)
continue;
if ((mask & OMP_CLAUSE_USES_ALLOCATORS)
&& (gfc_match ("uses_allocators ( ") == MATCH_YES))
{
if (gfc_match_omp_clause_uses_allocators (c) != MATCH_YES)
goto error;
continue;
}
break;
case 'v':
/* VECTOR_LENGTH must be matched before VECTOR, because the latter
@ -4290,7 +4399,7 @@ cleanup:
| OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \
| OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \
| OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE \
| OMP_CLAUSE_HAS_DEVICE_ADDR)
| OMP_CLAUSE_HAS_DEVICE_ADDR | OMP_CLAUSE_USES_ALLOCATORS)
#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)
@ -4410,7 +4519,7 @@ gfc_match_omp_allocate (void)
gfc_error ("Unexpected expression as list item at %L in ALLOCATE "
"directive", &n->expr->where);
gfc_free_omp_namelist (vars, false, true);
gfc_free_omp_namelist (vars, false, true, false);
goto error;
}
@ -4814,14 +4923,14 @@ gfc_match_omp_flush (void)
{
gfc_error ("List specified together with memory order clause in FLUSH "
"directive at %C");
gfc_free_omp_namelist (list, false, false);
gfc_free_omp_namelist (list, false, false, false);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
if (gfc_match_omp_eos () != MATCH_YES)
{
gfc_error ("Unexpected junk after $OMP FLUSH statement at %C");
gfc_free_omp_namelist (list, false, false);
gfc_free_omp_namelist (list, false, false, false);
gfc_free_omp_clauses (c);
return MATCH_ERROR;
}
@ -7229,7 +7338,8 @@ 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",
"USES_ALLOCATORS" };
STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM);
if (omp_clauses == NULL)
@ -7495,7 +7605,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
" cannot be and need not be mapped", n->sym->name,
&n->where);
}
else
else if (list != OMP_LIST_USES_ALLOCATORS)
gfc_error ("Object %qs is not a variable at %L", n->sym->name,
&n->where);
}
@ -7721,7 +7831,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
{
prev->next = n->next;
n->next = NULL;
gfc_free_omp_namelist (n, false, true);
gfc_free_omp_namelist (n, false, true, false);
n = prev->next;
}
continue;
@ -8291,6 +8401,58 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses,
n = n->next;
}
break;
case OMP_LIST_USES_ALLOCATORS:
{
if (n != NULL
&& n->u.memspace_sym
&& (n->u.memspace_sym->attr.flavor != FL_PARAMETER
|| n->u.memspace_sym->ts.type != BT_INTEGER
|| n->u.memspace_sym->ts.kind != gfc_c_intptr_kind
|| n->u.memspace_sym->attr.dimension
|| (!startswith (n->u.memspace_sym->name, "omp_")
&& !startswith (n->u.memspace_sym->name, "ompx_"))
|| !endswith (n->u.memspace_sym->name, "_mem_space")))
gfc_error ("Memspace %qs at %L in USES_ALLOCATORS must be "
"a predefined memory space",
n->u.memspace_sym->name, &n->where);
for (; n != NULL; n = n->next)
{
if (n->sym->ts.type != BT_INTEGER
|| n->sym->ts.kind != gfc_c_intptr_kind
|| n->sym->attr.dimension)
gfc_error ("Allocator %qs at %L in USES_ALLOCATORS must "
"be a scalar integer of kind "
"%<omp_allocator_handle_kind%>", n->sym->name,
&n->where);
else if (n->sym->attr.flavor != FL_VARIABLE
&& ((!startswith (n->sym->name, "omp_")
&& !startswith (n->sym->name, "ompx_"))
|| !endswith (n->sym->name, "_mem_alloc")))
gfc_error ("Allocator %qs at %L in USES_ALLOCATORS must "
"either a variable or a predefined allocator",
n->sym->name, &n->where);
else if ((n->u.memspace_sym || n->u2.traits_sym)
&& n->sym->attr.flavor != FL_VARIABLE)
gfc_error ("A memory space or traits array may not be "
"specified for predefined allocator %qs at %L",
n->sym->name, &n->where);
if (n->u2.traits_sym
&& (n->u2.traits_sym->attr.flavor != FL_PARAMETER
|| !n->u2.traits_sym->attr.dimension
|| n->u2.traits_sym->as->rank != 1
|| n->u2.traits_sym->ts.type != BT_DERIVED
|| strcmp (n->u2.traits_sym->ts.u.derived->name,
"omp_alloctrait") != 0))
{
gfc_error ("Traits array %qs in USES_ALLOCATORS %L must "
"be a one-dimensional named constant array of "
"type %<omp_alloctrait%>",
n->u2.traits_sym->name, &n->where);
break;
}
}
break;
}
default:
for (; n != NULL; n = n->next)
{

2
gcc/fortran/st.cc
View file

@ -288,7 +288,7 @@ gfc_free_statement (gfc_code *p)
break;
case EXEC_OMP_FLUSH:
gfc_free_omp_namelist (p->ext.omp_namelist, false, false);
gfc_free_omp_namelist (p->ext.omp_namelist, false, false, false);
break;
case EXEC_OMP_BARRIER:

11
gcc/fortran/trans-openmp.cc
View file

@ -3923,6 +3923,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
omp_clauses = gfc_trans_add_clause (node, omp_clauses);
}
break;
case OMP_LIST_USES_ALLOCATORS:
/* Ignore pre-defined allocators as no special treatment is needed. */
for (; n != NULL; n = n->next)
if (n->sym->attr.flavor == FL_VARIABLE)
break;
if (n != NULL)
sorry_at (input_location, "%<uses_allocators%> clause with traits "
"and memory spaces");
break;
default:
break;
}
@ -6581,6 +6590,8 @@ gfc_split_omp_clauses (gfc_code *code,
= code->ext.omp_clauses->device;
clausesa[GFC_OMP_SPLIT_TARGET].thread_limit
= code->ext.omp_clauses->thread_limit;
clausesa[GFC_OMP_SPLIT_TARGET].lists[OMP_LIST_USES_ALLOCATORS]
= code->ext.omp_clauses->lists[OMP_LIST_USES_ALLOCATORS];
for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++)
clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i]
= code->ext.omp_clauses->defaultmap[i];

168
libgomp/testsuite/libgomp.fortran/uses_allocators_1.f90 Normal file
View file

@ -0,0 +1,168 @@
! { dg-do compile }
subroutine test
use omp_lib
implicit none
!$omp target uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
!$omp& omp_const_mem_alloc,omp_high_bw_mem_alloc, &
!$omp& omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
!$omp& omp_pteam_mem_alloc, omp_thread_mem_alloc )
block; end block
!$omp target uses_allocators(omp_default_mem_alloc, omp_high_bw_mem_alloc) &
!$omp& uses_allocators(omp_high_bw_mem_alloc, omp_low_lat_mem_alloc) ! { dg-error "Symbol 'omp_high_bw_mem_alloc' present on multiple clauses" }
block; end block
!$omp target firstprivate ( omp_default_mem_alloc ) , uses_allocators &
!$omp& (omp_default_mem_alloc , omp_high_bw_mem_alloc ) &
!$omp& map(to: omp_high_bw_mem_alloc)
block; end block
! { dg-error "Object 'omp_default_mem_alloc' is not a variable" "" { target *-*-* } .-4 }
! { dg-error "Symbol 'omp_default_mem_alloc' present on both data and map clauses" "" { target *-*-* } .-5 }
! { dg-error "Symbol 'omp_high_bw_mem_alloc' present on multiple clauses" "" { target *-*-* } .-5 }
! { dg-error "Object 'omp_high_bw_mem_alloc' is not a variable at .1.; parameters cannot be and need not be mapped" "" { target *-*-* } .-5 }
end
subroutine non_predef
use omp_lib
implicit none
type(omp_alloctrait), parameter :: trait(0) = [omp_alloctrait :: ]
type(omp_alloctrait), parameter :: trait2(*) &
= [omp_alloctrait (omp_atk_alignment, 16), &
omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
omp_alloctrait (omp_atk_access, omp_atv_default)]
integer(kind=omp_allocator_handle_kind) :: a1, a2, a3
!$omp target uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2))
block; end block
!$omp target uses_allocators(omp_default_mem_alloc, a1(trait), omp_cgroup_mem_alloc, a1(trait2)) ! { dg-error "Symbol 'a1' present on multiple clauses" }
block; end block
!$omp target uses_allocators(traits(trait):a1) &
!$omp& uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3)
block; end block
!$omp target uses_allocators ( traits(trait2) , memspace ( omp_low_lat_mem_space ) : a2 , a3)
block; end block
!$omp target firstprivate ( a2 ) , & ! { dg-error "Symbol 'a2' present on both data and map clauses" }
!$omp& uses_allocators (a2, a3) & ! { dg-error "Symbol 'a3' present on multiple clauses" }
!$omp& map(to: a3)
block; end block
end subroutine
subroutine duplicate
use omp_lib
implicit none
type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
type(omp_alloctrait), parameter :: trait2(0) = [omp_alloctrait :: ]
!$omp target uses_allocators(traits(trait1), memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : bar) ! { dg-error "Duplicate TRAITS modifier" }
block; end block
!$omp target uses_allocators(traits(trait1), memspace ( omp_low_lat_mem_space ) , memspace (omp_large_cap_mem_space) : bar) ! { dg-error "Duplicate MEMSPACE modifier" }
block; end block
end
subroutine trait_present
use omp_lib
implicit none
type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
integer(kind=omp_allocator_handle_kind) :: a1
!$omp target uses_allocators(omp_cgroup_mem_alloc(trait1)) ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_cgroup_mem_alloc'" }
block; end block
!$omp target uses_allocators(traits(trait1) : omp_pteam_mem_alloc) ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_pteam_mem_alloc'" }
block; end block
!$omp target uses_allocators(memspace(omp_low_lat_mem_space) : omp_thread_mem_alloc) ! { dg-error "A memory space or traits array may not be specified for predefined allocator 'omp_thread_mem_alloc'" }
block; end block
! Invalid in OpenMP 5.0 / 5.1, but valid since 5.2 the same as omp_default_mem_space + emptry traits array
!$omp target uses_allocators ( a1 )
block; end block
end
subroutine odd_names
use omp_lib
implicit none
type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
! oddly named allocators:
integer(kind=omp_allocator_handle_kind) :: traits
integer(kind=omp_allocator_handle_kind) :: memspace
!$omp target uses_allocators ( traits(trait1), memspace(trait1) )
block; end block
!$omp target uses_allocators ( traits(trait1), memspace(omp_low_lat_mem_space) : traits)
block; end block
!$omp target uses_allocators ( memspace(omp_low_lat_mem_space), traits(trait1) : memspace)
block; end block
end
subroutine more_checks
use omp_lib
implicit none
integer(kind=kind(omp_low_lat_mem_space)) :: my_memspace
integer(kind=omp_allocator_handle_kind) :: a1, a2(4)
integer(kind=1) :: a3
!$omp target uses_allocators ( memspace(my_memspace) : a1) ! { dg-error "Memspace 'my_memspace' at .1. in USES_ALLOCATORS must be a predefined memory space" }
block; end block
!$omp target uses_allocators ( omp_low_lat_mem_space) ! { dg-error "Allocator 'omp_low_lat_mem_space' at .1. in USES_ALLOCATORS must either a variable or a predefined allocator" }
block; end block
!$omp target uses_allocators ( memspace (omp_low_lat_mem_alloc) : a1) ! { dg-error "Memspace 'omp_low_lat_mem_alloc' at .1. in USES_ALLOCATORS must be a predefined memory space" }
block; end block
!$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a1 )
block; end block
!$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a2 ) ! { dg-error "Allocator 'a2' at .1. in USES_ALLOCATORS must be a scalar integer of kind 'omp_allocator_handle_kind'" }
block; end block
!$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a3 ) ! { dg-error "Allocator 'a3' at .1. in USES_ALLOCATORS must be a scalar integer of kind 'omp_allocator_handle_kind'" }
block; end block
end
subroutine traits_checks
use omp_lib
implicit none
type(omp_alloctrait), parameter :: trait1 = omp_alloctrait (omp_atk_alignment, 16)
type(omp_alloctrait) :: trait2
integer(kind=omp_atk_alignment), parameter :: trait3(1) = omp_atk_alignment
integer(kind=omp_allocator_handle_kind) :: a1
! Sensible - but not (yet?) valid - an array constructor:
!$omp target uses_allocators(traits ([omp_alloctrait :: ]) : a1 ) ! { dg-error "Invalid character in name" }
block; end block
!$omp target uses_allocators(a1 ([omp_alloctrait :: ])) ! { dg-error "Invalid character in name" }
block; end block
!$omp target uses_allocators(traits (trait1) : a1 ) ! { dg-error "Traits array 'trait1' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
block; end block
!$omp target uses_allocators(a1 (trait1)) ! { dg-error "Traits array 'trait1' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
block; end block
!$omp target uses_allocators(traits (trait2) : a1 ) ! { dg-error "Traits array 'trait2' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
block; end block
!$omp target uses_allocators(a1 (trait2)) ! { dg-error "Traits array 'trait2' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
block; end block
!$omp target uses_allocators(traits (trait3) : a1 ) ! { dg-error "Traits array 'trait3' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
block; end block
!$omp target uses_allocators(a1 (trait3)) ! { dg-error "Traits array 'trait3' in USES_ALLOCATORS .1. must be a one-dimensional named constant array of type 'omp_alloctrait'" }
block; end block
end

99
libgomp/testsuite/libgomp.fortran/uses_allocators_2.f90 Normal file
View file

@ -0,0 +1,99 @@
! { dg-do compile }
! Minimal test for valid code:
! - predefined allocators do not need any special treatment in uses_allocators
! (as 'requires dynamic_allocators' is the default).
!
! - Non-predefined allocators are currently rejected ('sorry)'
subroutine test
use omp_lib
implicit none
!$omp target uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
!$omp& omp_const_mem_alloc,omp_high_bw_mem_alloc, &
!$omp& omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
!$omp& omp_pteam_mem_alloc, omp_thread_mem_alloc )
block; end block
!$omp target parallel uses_allocators ( omp_default_mem_alloc , omp_large_cap_mem_alloc, &
!$omp& omp_const_mem_alloc,omp_high_bw_mem_alloc, &
!$omp& omp_low_lat_mem_alloc ,omp_cgroup_mem_alloc , &
!$omp& omp_pteam_mem_alloc, omp_thread_mem_alloc )
block; end block
end
subroutine non_predef
use omp_lib
implicit none
type(omp_alloctrait), parameter :: trait(0) = [omp_alloctrait :: ]
type(omp_alloctrait), parameter :: trait2(*) &
= [omp_alloctrait (omp_atk_alignment, 16), &
omp_alloctrait (omp_atk_sync_hint, omp_atv_default), &
omp_alloctrait (omp_atk_access, omp_atv_default)]
integer(kind=omp_allocator_handle_kind) :: a1, a2, a3
!$omp target uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2)) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
!$omp target parallel uses_allocators(omp_default_mem_alloc, a1(trait), a2(trait2)) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
!$omp target uses_allocators(traits(trait):a1) &
!$omp& uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
!$omp target parallel uses_allocators(traits(trait):a1) &
!$omp& uses_allocators ( memspace ( omp_low_lat_mem_space ) , traits ( trait2 ) : a2 , a3) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
!$omp target uses_allocators ( traits(trait2) , memspace ( omp_low_lat_mem_space ) : a2 , a3) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
end subroutine
subroutine trait_present
use omp_lib
implicit none
type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
integer(kind=omp_allocator_handle_kind) :: a1
! Invalid in OpenMP 5.0 / 5.1, but valid since 5.2 the same as omp_default_mem_space + emptry traits array
!$omp target uses_allocators ( a1 ) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
end
subroutine odd_names
use omp_lib
implicit none
type(omp_alloctrait), parameter :: trait1(0) = [omp_alloctrait :: ]
! oddly named allocators:
integer(kind=omp_allocator_handle_kind) :: traits
integer(kind=omp_allocator_handle_kind) :: memspace
!$omp target uses_allocators ( traits(trait1), memspace(trait1) ) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
!$omp target uses_allocators ( traits(trait1), memspace(omp_low_lat_mem_space) : traits) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
!$omp target uses_allocators ( memspace(omp_low_lat_mem_space), traits(trait1) : memspace) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
end
subroutine more_checks
use omp_lib
implicit none
integer(kind=kind(omp_low_lat_mem_space)) :: my_memspace
integer(kind=omp_allocator_handle_kind) :: a1, a2(4)
integer(kind=1) :: a3
!$omp target uses_allocators(memspace (omp_low_lat_mem_space) : a1 ) ! { dg-message "sorry, unimplemented: 'uses_allocators' clause with traits and memory spaces" }
block; end block
end