public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc/devel/omp/gcc-12] Fortran "declare create"/allocate support for OpenACC
@ 2022-06-29 14:36 Kwok Yeung
0 siblings, 0 replies; only message in thread
From: Kwok Yeung @ 2022-06-29 14:36 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:924b6fcc1af265d017719b577fe09e32bfd46f9f
commit 924b6fcc1af265d017719b577fe09e32bfd46f9f
Author: Julian Brown <julian@codesourcery.com>
Date: Tue Feb 26 15:48:00 2019 -0800
Fortran "declare create"/allocate support for OpenACC
2018-10-04 Cesar Philippidis <cesar@codesourcery.com>
Julian Brown <julian@codesourcery.com>
gcc/
* omp-low.cc (scan_sharing_clauses): Update handling of OpenACC declare
create, declare copyin and declare deviceptr to have local lifetimes.
(convert_to_firstprivate_int): Handle pointer types.
(convert_from_firstprivate_int): Likewise. Create local storage for
the values being pointed to. Add new orig_type argument.
(lower_omp_target): Handle GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}.
Add orig_type argument to convert_from_firstprivate_int call.
Allow pointer types with GOMP_MAP_FIRSTPRIVATE_INT. Don't privatize
firstprivate VLAs.
* tree-pretty-print.cc (dump_omp_clause): Handle
GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}.
gcc/fortran/
* gfortran.h (enum gfc_omp_map_op): Add OMP_MAP_DECLARE_ALLOCATE,
OMP_MAP_DECLARE_DEALLOCATE.
(gfc_omp_clauses): Add update_allocatable.
* trans-array.cc (gfc_array_allocate): Call
gfc_trans_oacc_declare_allocate for decls that have oacc_declare_create
attribute set.
* trans-decl.cc (find_module_oacc_declare_clauses): Relax
oacc_declare_create to OMP_MAP_ALLOC, and oacc_declare_copyin to
OMP_MAP_TO, in order to match OpenACC 2.5 semantics.
* trans-openmp.cc (gfc_trans_omp_clauses): Use GOMP_MAP_ALWAYS_POINTER
(for update directive) or GOMP_MAP_FIRSTPRIVATE_POINTER (otherwise) for
allocatable scalar decls. Handle OMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}
clauses.
(gfc_trans_oacc_executable_directive): Use GOMP_MAP_ALWAYS_POINTER
for allocatable scalar data clauses inside acc update directives.
(gfc_trans_oacc_declare_allocate): New function.
* trans-stmt.cc (gfc_trans_allocate): Call
gfc_trans_oacc_declare_allocate for decls with oacc_declare_create
attribute set.
(gfc_trans_deallocate): Likewise.
* trans.h (gfc_trans_oacc_declare_allocate): Declare.
gcc/testsuite/
* gfortran.dg/goacc/declare-allocatable-1.f90: New test.
include/
* gomp-constants.h (enum gomp_map_kind): Define
GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE} and GOMP_MAP_FLAG_SPECIAL_4.
libgomp/
* oacc-mem.c (gomp_acc_declare_allocate): New function.
* oacc-parallel.c (GOACC_enter_exit_data): Handle
GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}.
* testsuite/libgomp.oacc-fortran/allocatable-scalar.f90: New test.
* testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90: New test.
* testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90: New test.
* testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90: New test.
* testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90: New test.
2020-02-19 Julian Brown <julian@codesourcery.com>
gcc/fortran/
* trans-openmp.cc (gfc_omp_check_optional_argument): Handle non-decl
case.
gcc/
* gimplify.cc (gimplify_scan_omp_clauses): Handle
GOMP_MAP_DECLARE_ALLOCATE and GOMP_MAP_DECLARE_DEALLOCATE.
libgomp/
* libgomp.h (gomp_acc_declare_allocate): Remove prototype.
* oacc-mem.c (gomp_acc_declare_allocate): Make static. Add POINTER
argument. Use acc_delete instead of acc_free. Handle scalar
mappings.
(find_group_last): Handle GOMP_MAP_DECLARE_ALLOCATE and
GOMP_MAP_DECLARE_DEALLOCATE groupings.
(goacc_enter_data_internal): Fix kind check for
GOMP_MAP_DECLARE_ALLOCATE. Pass new pointer argument to
gomp_acc_declare_allocate.
(goacc_exit_data_internal): Unlock device mutex around
gomp_acc_declare_allocate call. Pass new pointer argument. Handle
group pointer mapping for deallocate.
2021-04-07 Kwok Cheung Yeung <kcy@codesourcery.com>
libgomp/
* oacc-mem.c (goacc_enter_data_internal): Unlock mutex before calling
gomp_acc_declare_allocate and relock it afterwards.
Diff:
---
gcc/ChangeLog.omp | 20 ++
gcc/fortran/ChangeLog.omp | 30 +++
gcc/fortran/gfortran.h | 6 +-
gcc/fortran/trans-array.cc | 4 +
gcc/fortran/trans-decl.cc | 4 +-
gcc/fortran/trans-openmp.cc | 62 +++++-
gcc/fortran/trans-stmt.cc | 12 ++
gcc/fortran/trans.h | 1 +
gcc/gimplify.cc | 12 +-
gcc/omp-low.cc | 62 ++++--
gcc/testsuite/ChangeLog.omp | 5 +
.../gfortran.dg/goacc/declare-allocatable-1.f90 | 25 +++
gcc/tree-pretty-print.cc | 6 +
include/ChangeLog.omp | 6 +
include/gomp-constants.h | 5 +
libgomp/ChangeLog.omp | 24 +++
libgomp/libgomp.h | 2 -
libgomp/oacc-mem.c | 78 +++++++-
.../libgomp.oacc-fortran/allocatable-scalar.f90 | 33 ++++
.../libgomp.oacc-fortran/declare-allocatable-1.f90 | 211 ++++++++++++++++++++
.../libgomp.oacc-fortran/declare-allocatable-2.f90 | 48 +++++
.../libgomp.oacc-fortran/declare-allocatable-3.f90 | 218 +++++++++++++++++++++
.../libgomp.oacc-fortran/declare-allocatable-4.f90 | 66 +++++++
23 files changed, 910 insertions(+), 30 deletions(-)
diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp
index 84ebebbe7b6..67ccc2c80c0 100644
--- a/gcc/ChangeLog.omp
+++ b/gcc/ChangeLog.omp
@@ -1,3 +1,23 @@
+2020-02-19 Julian Brown <julian@codesourcery.com>
+
+ * gimplify.cc (gimplify_scan_omp_clauses): Handle
+ GOMP_MAP_DECLARE_ALLOCATE and GOMP_MAP_DECLARE_DEALLOCATE.
+
+2018-10-04 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+
+ * omp-low.c (scan_sharing_clauses): Update handling of OpenACC declare
+ create, declare copyin and declare deviceptr to have local lifetimes.
+ (convert_to_firstprivate_int): Handle pointer types.
+ (convert_from_firstprivate_int): Likewise. Create local storage for
+ the values being pointed to. Add new orig_type argument.
+ (lower_omp_target): Handle GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}.
+ Add orig_type argument to convert_from_firstprivate_int call.
+ Allow pointer types with GOMP_MAP_FIRSTPRIVATE_INT. Don't privatize
+ firstprivate VLAs.
+ * tree-pretty-print.c (dump_omp_clause): Handle
+ GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}.
+
2019-09-20 Julian Brown <julian@codesourcery.com>
* gimplify.cc (localize_reductions): Rewrite references for
diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp
index 176c23274b7..5dfe3858978 100644
--- a/gcc/fortran/ChangeLog.omp
+++ b/gcc/fortran/ChangeLog.omp
@@ -1,3 +1,33 @@
+2020-02-19 Julian Brown <julian@codesourcery.com>
+
+ * trans-openmp.ccc (gfc_omp_check_optional_argument): Handle non-decl
+ case.
+
+2018-10-04 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+
+ * gfortran.h (enum gfc_omp_map_op): Add OMP_MAP_DECLARE_ALLOCATE,
+ OMP_MAP_DECLARE_DEALLOCATE.
+ (gfc_omp_clauses): Add update_allocatable.
+ * trans-array.c (gfc_array_allocate): Call
+ gfc_trans_oacc_declare_allocate for decls that have oacc_declare_create
+ attribute set.
+ * trans-decl.c (find_module_oacc_declare_clauses): Relax oacc_declare_create to
+ OMP_MAP_ALLOC, and oacc_declare_copyin to OMP_MAP_TO, in order to
+ match OpenACC 2.5 semantics.
+ * trans-openmp.c (gfc_trans_omp_clauses): Use GOMP_MAP_ALWAYS_POINTER
+ (for update directive) or GOMP_MAP_FIRSTPRIVATE_POINTER (otherwise) for
+ allocatable scalar decls. Handle OMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE}
+ clauses.
+ (gfc_trans_oacc_executable_directive): Use GOMP_MAP_ALWAYS_POINTER
+ for allocatable scalar data clauses inside acc update directives.
+ (gfc_trans_oacc_declare_allocate): New function.
+ * trans-stmt.c (gfc_trans_allocate): Call
+ gfc_trans_oacc_declare_allocate for decls with oacc_declare_create
+ attribute set.
+ (gfc_trans_deallocate): Likewise.
+ * trans.h (gfc_trans_oacc_declare_allocate): Declare.
+
2019-07-10 Julian Brown <julian@codesourcery.com>
* trans-openmp.cc (gfc_omp_finish_clause): Change clauses mapping
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 7bf1d5a0452..b1d78270236 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1298,7 +1298,9 @@ enum gfc_omp_map_op
OMP_MAP_RELEASE,
OMP_MAP_ALWAYS_TO,
OMP_MAP_ALWAYS_FROM,
- OMP_MAP_ALWAYS_TOFROM
+ OMP_MAP_ALWAYS_TOFROM,
+ OMP_MAP_DECLARE_ALLOCATE,
+ OMP_MAP_DECLARE_DEALLOCATE
};
enum gfc_omp_defaultmap
@@ -1559,7 +1561,7 @@ typedef struct gfc_omp_clauses
unsigned async:1, gang:1, worker:1, vector:1, seq:1, independent:1;
unsigned par_auto:1, gang_static:1;
unsigned if_present:1, finalize:1;
- unsigned nohost:1;
+ unsigned nohost:1, update_allocatable:1;
locus loc;
}
gfc_omp_clauses;
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 05134952db4..1e6ead6f502 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -6060,6 +6060,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
gfc_ref *ref, *prev_ref = NULL, *coref;
bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false,
non_ulimate_coarray_ptr_comp;
+ bool oacc_declare = false;
ref = expr->ref;
@@ -6074,6 +6075,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
allocatable = expr->symtree->n.sym->attr.allocatable;
dimension = expr->symtree->n.sym->attr.dimension;
non_ulimate_coarray_ptr_comp = false;
+ oacc_declare = expr->symtree->n.sym->attr.oacc_declare_create;
}
else
{
@@ -6258,6 +6260,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
gfc_conv_descriptor_offset_set (&set_descriptor_block, se->expr, offset);
tmp = fold_convert (gfc_array_index_type, element_size);
gfc_conv_descriptor_span_set (&set_descriptor_block, se->expr, tmp);
+ if (oacc_declare)
+ gfc_trans_oacc_declare_allocate (&set_descriptor_block, expr, true);
}
set_descriptor = gfc_finish_block (&set_descriptor_block);
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 6493cc2f6b1..2373dd2804e 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -6537,10 +6537,10 @@ find_module_oacc_declare_clauses (gfc_symbol *sym)
gfc_omp_map_op map_op;
if (sym->attr.oacc_declare_create)
- map_op = OMP_MAP_FORCE_ALLOC;
+ map_op = OMP_MAP_ALLOC;
if (sym->attr.oacc_declare_copyin)
- map_op = OMP_MAP_FORCE_TO;
+ map_op = OMP_MAP_TO;
if (sym->attr.oacc_declare_deviceptr)
map_op = OMP_MAP_FORCE_DEVICEPTR;
diff --git a/gcc/fortran/trans-openmp.cc b/gcc/fortran/trans-openmp.cc
index e0121af1465..dd7f548ac24 100644
--- a/gcc/fortran/trans-openmp.cc
+++ b/gcc/fortran/trans-openmp.cc
@@ -95,6 +95,10 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check)
if (!for_present_check)
return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE;
+ if (!DECL_P (decl))
+ return fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+ decl, null_pointer_node);
+
if (!DECL_LANG_SPECIFIC (decl))
return NULL_TREE;
@@ -3049,6 +3053,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
case OMP_MAP_FORCE_DEVICEPTR:
OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_FORCE_DEVICEPTR);
break;
+ case OMP_MAP_DECLARE_ALLOCATE:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DECLARE_ALLOCATE);
+ break;
+ case OMP_MAP_DECLARE_DEALLOCATE:
+ OMP_CLAUSE_SET_MAP_KIND (node, GOMP_MAP_DECLARE_DEALLOCATE);
+ break;
default:
gcc_unreachable ();
}
@@ -3131,6 +3141,15 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
|| n->sym->ts.type == BT_DERIVED))
{
tree orig_decl = decl;
+ enum gomp_map_kind gmk = GOMP_MAP_POINTER;
+ if (GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
+ && n->sym->attr.oacc_declare_create)
+ {
+ if (clauses->update_allocatable)
+ gmk = GOMP_MAP_ALWAYS_POINTER;
+ else
+ gmk = GOMP_MAP_FIRSTPRIVATE_POINTER;
+ }
/* For nonallocatable, nonpointer arrays, a temporary
variable is generated, but this one is only defined if
@@ -3157,7 +3176,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
}
node4 = build_omp_clause (input_location,
OMP_CLAUSE_MAP);
- OMP_CLAUSE_SET_MAP_KIND (node4, GOMP_MAP_POINTER);
+ OMP_CLAUSE_SET_MAP_KIND (node4, gmk);
OMP_CLAUSE_DECL (node4) = decl;
OMP_CLAUSE_SIZE (node4) = size_int (0);
decl = build_fold_indirect_ref (decl);
@@ -4477,12 +4496,14 @@ gfc_trans_oacc_executable_directive (gfc_code *code)
{
stmtblock_t block;
tree stmt, oacc_clauses;
+ gfc_omp_clauses *clauses = code->ext.omp_clauses;
enum tree_code construct_code;
switch (code->op)
{
case EXEC_OACC_UPDATE:
construct_code = OACC_UPDATE;
+ clauses->update_allocatable = 1;
break;
case EXEC_OACC_ENTER_DATA:
construct_code = OACC_ENTER_DATA;
@@ -4498,8 +4519,8 @@ gfc_trans_oacc_executable_directive (gfc_code *code)
}
gfc_start_block (&block);
- oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.omp_clauses,
- code->loc, false, true);
+ oacc_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc,
+ false, true);
stmt = build1_loc (input_location, construct_code, void_type_node,
oacc_clauses);
gfc_add_expr_to_block (&block, stmt);
@@ -7406,6 +7427,41 @@ gfc_trans_oacc_declare (gfc_code *code)
return gfc_finish_block (&block);
}
+/* Create an OpenACC enter or exit data construct for an OpenACC declared
+ variable that has been allocated or deallocated. */
+
+tree
+gfc_trans_oacc_declare_allocate (stmtblock_t *block, gfc_expr *expr,
+ bool allocate)
+{
+ gfc_omp_clauses *clauses = gfc_get_omp_clauses ();
+ gfc_omp_namelist *p = gfc_get_omp_namelist ();
+ tree oacc_clauses, stmt;
+ enum tree_code construct_code;
+
+ p->sym = expr->symtree->n.sym;
+ p->where = expr->where;
+
+ if (allocate)
+ {
+ p->u.map_op = OMP_MAP_DECLARE_ALLOCATE;
+ construct_code = OACC_ENTER_DATA;
+ }
+ else
+ {
+ p->u.map_op = OMP_MAP_DECLARE_DEALLOCATE;
+ construct_code = OACC_EXIT_DATA;
+ }
+ clauses->lists[OMP_LIST_MAP] = p;
+
+ oacc_clauses = gfc_trans_omp_clauses (block, clauses, expr->where);
+ stmt = build1_loc (input_location, construct_code, void_type_node,
+ oacc_clauses);
+ gfc_add_expr_to_block (block, stmt);
+
+ return stmt;
+}
+
tree
gfc_trans_oacc_directive (gfc_code *code)
{
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 79096816c6e..333bc50e927 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -6855,6 +6855,10 @@ gfc_trans_allocate (gfc_code * code)
label_finish, expr, 0);
else
gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
+
+ /* Allocate memory for OpenACC declared variables. */
+ if (expr->symtree->n.sym->attr.oacc_declare_create)
+ gfc_trans_oacc_declare_allocate (&se.pre, expr, true);
}
else
{
@@ -7328,6 +7332,10 @@ gfc_trans_deallocate (gfc_code *code)
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
{
+ if (!is_coarray
+ && expr->symtree->n.sym->attr.oacc_declare_create)
+ gfc_trans_oacc_declare_allocate (&se.pre, expr, false);
+
gfc_coarray_deregtype caf_dtype;
if (is_coarray)
@@ -7381,6 +7389,10 @@ gfc_trans_deallocate (gfc_code *code)
}
else
{
+ /* Deallocate memory for OpenACC declared variables. */
+ if (expr->symtree->n.sym->attr.oacc_declare_create)
+ gfc_trans_oacc_declare_allocate (&se.pre, expr, false);
+
tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, label_finish,
false, al->expr,
al->expr->ts, is_coarray);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 623aceed520..ed678877738 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -826,6 +826,7 @@ bool gfc_omp_private_debug_clause (tree, bool);
bool gfc_omp_private_outer_ref (tree);
struct gimplify_omp_ctx;
void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
+tree gfc_trans_oacc_declare_allocate (stmtblock_t *, gfc_expr *, bool);
/* In trans-intrinsic.cc. */
void gfc_conv_intrinsic_mvbits (gfc_se *, gfc_actual_arglist *,
diff --git a/gcc/gimplify.cc b/gcc/gimplify.cc
index 576633ecf3d..7fcf4e48da4 100644
--- a/gcc/gimplify.cc
+++ b/gcc/gimplify.cc
@@ -9593,9 +9593,15 @@ gimplify_scan_omp_clauses (tree *list_p, gimple_seq *pre_p,
case OACC_ENTER_DATA:
case OACC_EXIT_DATA:
case OACC_HOST_DATA:
- if (OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_POINTER
- || (OMP_CLAUSE_MAP_KIND (c)
- == GOMP_MAP_FIRSTPRIVATE_REFERENCE))
+ if ((OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_FIRSTPRIVATE_POINTER
+ || (OMP_CLAUSE_MAP_KIND (c)
+ == GOMP_MAP_FIRSTPRIVATE_REFERENCE))
+ && !(prev_list_p
+ && OMP_CLAUSE_CODE (*prev_list_p) == OMP_CLAUSE_MAP
+ && ((OMP_CLAUSE_MAP_KIND (*prev_list_p)
+ == GOMP_MAP_DECLARE_ALLOCATE)
+ || (OMP_CLAUSE_MAP_KIND (*prev_list_p)
+ == GOMP_MAP_DECLARE_DEALLOCATE))))
/* For target {,enter ,exit }data only the array slice is
mapped, but not the pointer to it. */
remove = true;
diff --git a/gcc/omp-low.cc b/gcc/omp-low.cc
index 37a8a7720cb..3a7d5915f7b 100644
--- a/gcc/omp-low.cc
+++ b/gcc/omp-low.cc
@@ -1681,7 +1681,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx,
&& is_global_var (maybe_lookup_decl_in_outer_ctx (decl, ctx))
&& varpool_node::get_create (decl)->offloadable
&& !lookup_attribute ("omp declare target link",
- DECL_ATTRIBUTES (decl)))
+ DECL_ATTRIBUTES (decl))
+ && !is_gimple_omp_oacc (ctx->stmt))
break;
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_MAP
&& OMP_CLAUSE_MAP_KIND (c) == GOMP_MAP_POINTER)
@@ -12875,7 +12876,7 @@ convert_to_firstprivate_int (tree var, gimple_seq *gs)
{
tree type = TREE_TYPE (var), new_type = NULL_TREE;
- if (omp_privatize_by_reference (var))
+ if (omp_privatize_by_reference (var) || POINTER_TYPE_P (type))
{
type = TREE_TYPE (type);
tree tmp = create_tmp_var (type);
@@ -12900,7 +12901,8 @@ convert_to_firstprivate_int (tree var, gimple_seq *gs)
/* Like convert_to_firstprivate_int, but restore the original type. */
static tree
-convert_from_firstprivate_int (tree var, bool is_ref, gimple_seq *gs)
+convert_from_firstprivate_int (tree var, tree orig_type, bool is_ref,
+ gimple_seq *gs)
{
tree type = TREE_TYPE (var);
tree new_type = NULL_TREE;
@@ -12909,7 +12911,31 @@ convert_from_firstprivate_int (tree var, bool is_ref, gimple_seq *gs)
gcc_assert (TREE_CODE (var) == MEM_REF);
var = TREE_OPERAND (var, 0);
- if (INTEGRAL_TYPE_P (var) || POINTER_TYPE_P (type))
+ if (is_ref || POINTER_TYPE_P (orig_type))
+ {
+ tree_code code = NOP_EXPR;
+
+ if (TREE_CODE (type) == REAL_TYPE || TREE_CODE (type) == COMPLEX_TYPE)
+ code = VIEW_CONVERT_EXPR;
+
+ if (code == VIEW_CONVERT_EXPR
+ && TYPE_SIZE (type) != TYPE_SIZE (orig_type))
+ {
+ tree ptype = build_pointer_type (type);
+ var = fold_build1 (code, ptype, build_fold_addr_expr (var));
+ var = build_simple_mem_ref (var);
+ }
+ else
+ var = fold_build1 (code, type, var);
+
+ tree inst = create_tmp_var (type);
+ gimplify_assign (inst, var, gs);
+ var = build_fold_addr_expr (inst);
+
+ return var;
+ }
+
+ if (INTEGRAL_TYPE_P (var))
return fold_convert (type, var);
gcc_assert (tree_to_uhwi (TYPE_SIZE (type)) <= POINTER_SIZE);
@@ -12920,16 +12946,8 @@ convert_from_firstprivate_int (tree var, bool is_ref, gimple_seq *gs)
tmp = create_tmp_var (new_type);
var = fold_convert (new_type, var);
gimplify_assign (tmp, var, gs);
- var = fold_build1 (VIEW_CONVERT_EXPR, type, tmp);
-
- if (is_ref)
- {
- tmp = create_tmp_var (build_pointer_type (type));
- gimplify_assign (tmp, build_fold_addr_expr (var), gs);
- var = tmp;
- }
- return var;
+ return fold_build1 (VIEW_CONVERT_EXPR, type, tmp);
}
/* Lower the GIMPLE_OMP_TARGET in the current statement
@@ -13070,6 +13088,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
case GOMP_MAP_NONCONTIG_ARRAY_ALLOC:
case GOMP_MAP_NONCONTIG_ARRAY_FORCE_ALLOC:
case GOMP_MAP_NONCONTIG_ARRAY_FORCE_PRESENT:
+ case GOMP_MAP_DECLARE_ALLOCATE:
+ case GOMP_MAP_DECLARE_DEALLOCATE:
case GOMP_MAP_LINK:
case GOMP_MAP_FORCE_DETACH:
gcc_assert (is_gimple_omp_oacc (stmt));
@@ -13164,7 +13184,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
&& !maybe_lookup_field_in_outer_ctx (var, ctx))
{
gcc_assert (is_gimple_omp_oacc (ctx->stmt));
- x = convert_from_firstprivate_int (x,
+ x = convert_from_firstprivate_int (x, TREE_TYPE (new_var),
omp_privatize_by_reference (var),
&fplist);
gimplify_assign (new_var, x, &fplist);
@@ -13182,13 +13202,20 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
gcc_assert (is_gimple_omp_oacc (ctx->stmt));
if (omp_privatize_by_reference (new_var)
&& (TREE_CODE (var_type) != POINTER_TYPE
- || DECL_BY_REFERENCE (var)))
+ || DECL_BY_REFERENCE (var))
+ /* Accelerators may not have alloca, so it's not
+ possible to privatize local storage for those
+ objects. */
+ && TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (var_type))))
{
/* Create a local object to hold the instance
value. */
const char *id = IDENTIFIER_POINTER (DECL_NAME (new_var));
tree inst = create_tmp_var (TREE_TYPE (var_type), id);
- gimplify_assign (inst, fold_indirect_ref (x), &fplist);
+ if (TREE_CODE (var_type) == POINTER_TYPE)
+ gimplify_assign (inst, x, &fplist);
+ else
+ gimplify_assign (inst, fold_indirect_ref (x), &fplist);
x = build_fold_addr_expr (inst);
}
gimplify_assign (new_var, x, &fplist);
@@ -13542,9 +13569,10 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
else if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FIRSTPRIVATE)
{
gcc_checking_assert (is_gimple_omp_oacc (ctx->stmt));
+ tree new_var = lookup_decl (var, ctx);
tree type = TREE_TYPE (var);
tree inner_type
- = omp_privatize_by_reference (var)
+ = omp_privatize_by_reference (new_var)
? TREE_TYPE (type) : type;
if ((FLOAT_TYPE_P (inner_type)
|| ANY_INTEGRAL_TYPE_P (inner_type))
diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp
index 4c45d819715..edc69b0145a 100644
--- a/gcc/testsuite/ChangeLog.omp
+++ b/gcc/testsuite/ChangeLog.omp
@@ -1,3 +1,8 @@
+2018-10-04 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+
+ * gfortran.dg/goacc/declare-allocatable-1.f90: New test.
+
2019-09-17 Julian Brown <julian@codesourcery.com>
* c-c++-common/goacc/note-parallelism-1-kernels-loop-auto.c: Update
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-allocatable-1.f90 b/gcc/testsuite/gfortran.dg/goacc/declare-allocatable-1.f90
new file mode 100644
index 00000000000..5349e0d5b00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-allocatable-1.f90
@@ -0,0 +1,25 @@
+! Verify that OpenACC declared allocatable arrays have implicit
+! OpenACC enter and exit pragmas at the time of allocation and
+! deallocation.
+
+! { dg-additional-options "-fdump-tree-original" }
+
+program allocate
+ implicit none
+ integer, allocatable :: a(:), b
+ integer, parameter :: n = 100
+ integer i
+ !$acc declare create(a,b)
+
+ allocate (a(n), b)
+
+ !$acc parallel loop copyout(a, b)
+ do i = 1, n
+ a(i) = b
+ end do
+
+ deallocate (a, b)
+end program allocate
+
+! { dg-final { scan-tree-dump-times "pragma acc enter data map.declare_allocate" 2 "original" } }
+! { dg-final { scan-tree-dump-times "pragma acc exit data map.declare_deallocate" 2 "original" } }
diff --git a/gcc/tree-pretty-print.cc b/gcc/tree-pretty-print.cc
index d52dfa0c212..d913f48e82d 100644
--- a/gcc/tree-pretty-print.cc
+++ b/gcc/tree-pretty-print.cc
@@ -928,6 +928,12 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags)
case GOMP_MAP_LINK:
pp_string (pp, "link");
break;
+ case GOMP_MAP_DECLARE_ALLOCATE:
+ pp_string (pp, "declare_allocate");
+ break;
+ case GOMP_MAP_DECLARE_DEALLOCATE:
+ pp_string (pp, "declare_deallocate");
+ break;
case GOMP_MAP_ATTACH:
pp_string (pp, "attach");
break;
diff --git a/include/ChangeLog.omp b/include/ChangeLog.omp
index 9bd3fb60a78..a460e639d22 100644
--- a/include/ChangeLog.omp
+++ b/include/ChangeLog.omp
@@ -1,3 +1,9 @@
+2018-10-04 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+
+ * gomp-constants.h (enum gomp_map_kind): Define
+ GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE} and GOMP_MAP_FLAG_SPECIAL_4.
+
2020-04-19 Chung-Lin Tang <cltang@codesourcery.com>
PR other/76739
diff --git a/include/gomp-constants.h b/include/gomp-constants.h
index 85f40efcd5a..a8ab097d5d9 100644
--- a/include/gomp-constants.h
+++ b/include/gomp-constants.h
@@ -155,6 +155,11 @@ enum gomp_map_kind
/* Decrement usage count and deallocate if zero. */
GOMP_MAP_RELEASE = (GOMP_MAP_FLAG_SPECIAL_2
| GOMP_MAP_DELETE),
+ /* Mapping kinds for allocatable arrays. */
+ GOMP_MAP_DECLARE_ALLOCATE = (GOMP_MAP_FLAG_SPECIAL_4
+ | GOMP_MAP_FORCE_TO),
+ GOMP_MAP_DECLARE_DEALLOCATE = (GOMP_MAP_FLAG_SPECIAL_4
+ | GOMP_MAP_FORCE_FROM),
/* The attach/detach mappings below use the OMP_CLAUSE_SIZE field as a
bias. This will typically be zero, except when mapping an array slice
with a non-zero base. In that case the bias will indicate the
diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index fd89e921512..6ac1b743ccf 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,27 @@
+2021-04-07 Kwok Cheung Yeung <kcy@codesourcery.com>
+
+ * oacc-mem.c (goacc_enter_data_internal): Unlock mutex before calling
+ gomp_acc_declare_allocate and relock it afterwards.
+
+2018-10-04 Cesar Philippidis <cesar@codesourcery.com>
+ Julian Brown <julian@codesourcery.com>
+
+ * libgomp.h (gomp_acc_declare_allocate): Remove prototype.
+ * oacc-mem.c (gomp_acc_declare_allocate): New function.
+ * oacc-parallel.c (goacc_enter_data_internal): Handle
+ GOMP_MAP_DECLARE_ALLOCATE. Pass new pointer argument to
+ gomp_acc_declare_allocate.
+ (goacc_exit_data_internal): Handle GOMP_MAP_DECLARE_DEALLOCATE.
+ Unlock device mutex around gomp_acc_declare_allocate call. Pass
+ new pointer argument. Handle group pointer mapping for deallocate.
+ (find_group_last): Handle GOMP_MAP_DECLARE_ALLOCATE and
+ GOMP_MAP_DECLARE_DEALLOCATE groupings.
+ * testsuite/libgomp.oacc-fortran/allocatable-scalar.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90: New test.
+
2019-09-17 Julian Brown <julian@codesourcery.com>
* oacc-host.c (host_openacc_async_queue_callback): Invoke callback
diff --git a/libgomp/libgomp.h b/libgomp/libgomp.h
index 686149e70cb..576da9ecbd9 100644
--- a/libgomp/libgomp.h
+++ b/libgomp/libgomp.h
@@ -1270,8 +1270,6 @@ enum gomp_map_vars_kind
GOMP_MAP_VARS_ENTER_DATA = 8
};
-extern void gomp_acc_declare_allocate (bool, size_t, void **, size_t *,
- unsigned short *);
struct gomp_coalesce_buf;
extern void gomp_copy_host2dev (struct gomp_device_descr *,
struct goacc_asyncqueue *, void *, const void *,
diff --git a/libgomp/oacc-mem.c b/libgomp/oacc-mem.c
index 9ea625837c5..dacffcdefeb 100644
--- a/libgomp/oacc-mem.c
+++ b/libgomp/oacc-mem.c
@@ -911,6 +911,35 @@ acc_update_self_async (void *h, size_t s, int async)
update_dev_host (0, h, s, async);
}
+/* Implement "declare allocate" and "declare deallocate" operations. The
+ device lock must not be held before calling this function. */
+
+static void
+gomp_acc_declare_allocate (bool allocate, bool pointer, void **hostaddrs,
+ size_t *sizes, unsigned short *kinds)
+{
+ gomp_debug (0, " %s: processing\n", __FUNCTION__);
+
+ if (allocate)
+ {
+ /* Allocate memory for the array data. */
+ uintptr_t data = (uintptr_t) acc_create (hostaddrs[0], sizes[0]);
+
+ if (pointer)
+ {
+ /* Update the PSET. */
+ acc_update_device (hostaddrs[1], sizes[1]);
+ void *pset = acc_deviceptr (hostaddrs[1]);
+ acc_memcpy_to_device (pset, &data, sizeof (uintptr_t));
+ }
+ }
+ else
+ /* Deallocate memory for the array data. */
+ acc_delete (hostaddrs[0], sizes[0]);
+
+ gomp_debug (0, " %s: end\n", __FUNCTION__);
+}
+
void
acc_attach_async (void **hostaddr, int async)
{
@@ -1041,6 +1070,28 @@ find_group_last (int pos, size_t mapnum, size_t *sizes, unsigned short *kinds)
case GOMP_MAP_ATTACH:
break;
+ case GOMP_MAP_DECLARE_ALLOCATE:
+ case GOMP_MAP_DECLARE_DEALLOCATE:
+ {
+ /* The "declare allocate" and "declare deallocate" mappings can be
+ used to specify either a scalar allocatable (which just appears as
+ GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE} by itself), or an array
+ allocatable (which appears as that directive followed by a
+ GOMP_MAP_TO_PSET and one (or more?) GOMP_MAP_POINTER mappings. */
+ if (pos + 1 >= mapnum)
+ break;
+
+ unsigned char kind1 = kinds[pos + 1] & 0xff;
+ if (kind1 != GOMP_MAP_TO_PSET)
+ break;
+
+ pos++;
+
+ while (pos + 1 < mapnum && (kinds[pos + 1] & 0xff) == GOMP_MAP_POINTER)
+ pos++;
+ }
+ break;
+
default:
/* GOMP_MAP_ALWAYS_POINTER can only appear directly after some other
mapping. */
@@ -1105,7 +1156,14 @@ goacc_enter_data_internal (struct gomp_device_descr *acc_dev, size_t mapnum,
n = lookup_host (acc_dev, hostaddrs[i], size);
- if (n && struct_p)
+ if ((kinds[i] & 0xff) == GOMP_MAP_DECLARE_ALLOCATE)
+ {
+ gomp_mutex_unlock (&acc_dev->lock);
+ gomp_acc_declare_allocate (true, group_last > i, &hostaddrs[i],
+ &sizes[i], &kinds[i]);
+ gomp_mutex_lock (&acc_dev->lock);
+ }
+ else if (n && struct_p)
{
for (size_t j = i + 1; j <= group_last; j++)
{
@@ -1309,6 +1367,24 @@ goacc_exit_data_internal (struct gomp_device_descr *acc_dev, size_t mapnum,
reference counts ('n->refcount', 'n->dynamic_refcount'). */
break;
+ case GOMP_MAP_DECLARE_DEALLOCATE:
+ {
+ bool deallocate_pointer
+ = i + 1 < mapnum && (kinds[i + 1] & 0xff) == GOMP_MAP_TO_PSET;
+ gomp_mutex_unlock (&acc_dev->lock);
+ gomp_acc_declare_allocate (false, deallocate_pointer,
+ &hostaddrs[i], &sizes[i], &kinds[i]);
+ gomp_mutex_lock (&acc_dev->lock);
+ if (deallocate_pointer)
+ {
+ i++;
+ while (i + 1 < mapnum
+ && (kinds[i + 1] & 0xff) == GOMP_MAP_POINTER)
+ i++;
+ }
+ }
+ break;
+
default:
gomp_fatal (">>>> goacc_exit_data_internal UNHANDLED kind 0x%.2x",
kind);
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/allocatable-scalar.f90 b/libgomp/testsuite/libgomp.oacc-fortran/allocatable-scalar.f90
new file mode 100644
index 00000000000..42b34082288
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/allocatable-scalar.f90
@@ -0,0 +1,33 @@
+! Test non-declared allocatable scalars in OpenACC data clauses.
+
+! { dg-do run }
+
+program main
+ implicit none
+ integer, parameter :: n = 100
+ integer, allocatable :: a, c
+ integer :: i, b(n)
+
+ allocate (a)
+
+ a = 50
+
+ !$acc parallel loop
+ do i = 1, n;
+ b(i) = a
+ end do
+
+ do i = 1, n
+ if (b(i) /= a) stop 1
+ end do
+
+ allocate (c)
+
+ !$acc parallel copyout(c) num_gangs(1)
+ c = a
+ !$acc end parallel
+
+ if (c /= a) stop 2
+
+ deallocate (a, c)
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90
new file mode 100644
index 00000000000..ec7f7c18ff3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90
@@ -0,0 +1,211 @@
+! Test declare create with allocatable arrays.
+
+! { dg-do run }
+
+module vars
+ implicit none
+ integer, parameter :: n = 100
+ real*8, allocatable :: b(:)
+ !$acc declare create (b)
+end module vars
+
+program test
+ use vars
+ use openacc
+ implicit none
+ real*8 :: a
+ integer :: i
+
+ interface
+ subroutine sub1
+ !$acc routine gang
+ end subroutine sub1
+
+ subroutine sub2
+ end subroutine sub2
+
+ real*8 function fun1 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun1
+
+ real*8 function fun2 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun2
+ end interface
+
+ if (allocated (b)) stop 1
+
+ ! Test local usage of an allocated declared array.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 2
+ if (acc_is_present (b) .neqv. .true.) stop 3
+
+ a = 2.0
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = i * a
+ end do
+
+ if (.not.acc_is_present (b)) stop 4
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= i*a) stop 5
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside an acc
+ ! routine subroutine.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 6
+ if (acc_is_present (b) .neqv. .true.) stop 7
+
+ !$acc parallel
+ call sub1
+ !$acc end parallel
+
+ if (.not.acc_is_present (b)) stop 8
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= i*2) stop 9
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside a host
+ ! subroutine.
+
+ call sub2
+
+ if (.not.acc_is_present (b)) stop 10
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= 1.0) stop 11
+ end do
+
+ deallocate (b)
+
+ if (allocated (b)) stop 12
+
+ ! Test the usage of an allocated declared array inside an acc
+ ! routine function.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 13
+ if (acc_is_present (b) .neqv. .true.) stop 14
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = fun1 (i)
+ end do
+
+ if (.not.acc_is_present (b)) stop 15
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= i) stop 16
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside a host
+ ! function.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 17
+ if (acc_is_present (b) .neqv. .true.) stop 18
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+
+ !$acc update host(b)
+
+ do i = 1, n
+ b(i) = fun2 (i)
+ end do
+
+ if (.not.acc_is_present (b)) stop 19
+
+ do i = 1, n
+ if (b(i) /= i*i) stop 20
+ end do
+
+ deallocate (b)
+end program test
+
+! Set each element in array 'b' at index i to i*2.
+
+subroutine sub1 ! { dg-warning "region is worker partitioned" }
+ use vars
+ implicit none
+ integer i
+ !$acc routine gang
+
+ !$acc loop
+ do i = 1, n
+ b(i) = i*2
+ end do
+end subroutine sub1
+
+! Allocate array 'b', and set it to all 1.0.
+
+subroutine sub2
+ use vars
+ use openacc
+ implicit none
+ integer i
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 21
+ if (acc_is_present (b) .neqv. .true.) stop 22
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+end subroutine sub2
+
+! Return b(i) * i;
+
+real*8 function fun1 (i)
+ use vars
+ implicit none
+ integer i
+ !$acc routine seq
+
+ fun1 = b(i) * i
+end function fun1
+
+! Return b(i) * i * i;
+
+real*8 function fun2 (i)
+ use vars
+ implicit none
+ integer i
+
+ fun2 = b(i) * i * i
+end function fun2
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90
new file mode 100644
index 00000000000..df5ab26b8c2
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90
@@ -0,0 +1,48 @@
+! Test declare create with allocatable scalars.
+
+! { dg-do run }
+
+program main
+ use openacc
+ implicit none
+ integer, parameter :: n = 100
+ integer, allocatable :: a, c
+ integer :: i, b(n)
+ !$acc declare create (c)
+
+ allocate (a)
+
+ a = 50
+
+ !$acc parallel loop firstprivate(a)
+ do i = 1, n;
+ b(i) = a
+ end do
+
+ do i = 1, n
+ if (b(i) /= a) stop 1
+ end do
+
+ allocate (c)
+ a = 100
+
+ if (.not.acc_is_present(c)) stop 2
+
+ !$acc parallel num_gangs(1) present(c)
+ c = a
+ !$acc end parallel
+
+ !$acc update host(c)
+ if (c /= a) stop 3
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = c
+ end do
+
+ do i = 1, n
+ if (b(i) /= a) stop 4
+ end do
+
+ deallocate (a, c)
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90
new file mode 100644
index 00000000000..9381b00343d
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90
@@ -0,0 +1,218 @@
+! Test declare create with allocatable arrays.
+
+! { dg-do run }
+
+module vars
+ implicit none
+ integer, parameter :: n = 100
+ real*8, allocatable :: a, b(:)
+ !$acc declare create (a, b)
+end module vars
+
+program test
+ use vars
+ use openacc
+ implicit none
+ integer :: i
+
+ interface
+ subroutine sub1
+ !$acc routine gang
+ end subroutine sub1
+
+ subroutine sub2
+ end subroutine sub2
+
+ real*8 function fun1 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun1
+
+ real*8 function fun2 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun2
+ end interface
+
+ if (allocated (a)) stop 1
+ if (allocated (b)) stop 2
+
+ ! Test local usage of an allocated declared array.
+
+ allocate (a)
+
+ if (.not.allocated (a)) stop 3
+ if (acc_is_present (a) .neqv. .true.) stop 4
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 5
+ if (acc_is_present (b) .neqv. .true.) stop 6
+
+ a = 2.0
+ !$acc update device(a)
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = i * a
+ end do
+
+ if (.not.acc_is_present (b)) stop 7
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= i*a) stop 8
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside an acc
+ ! routine subroutine.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 9
+ if (acc_is_present (b) .neqv. .true.) stop 10
+
+ !$acc parallel
+ call sub1
+ !$acc end parallel
+
+ if (.not.acc_is_present (b)) stop 11
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= a+i*2) stop 12
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside a host
+ ! subroutine.
+
+ call sub2
+
+ if (.not.acc_is_present (b)) stop 13
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= 1.0) stop 14
+ end do
+
+ deallocate (b)
+
+ if (allocated (b)) stop 15
+
+ ! Test the usage of an allocated declared array inside an acc
+ ! routine function.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 16
+ if (acc_is_present (b) .neqv. .true.) stop 17
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = fun1 (i)
+ end do
+
+ if (.not.acc_is_present (b)) stop 18
+
+ !$acc update host(b)
+
+ do i = 1, n
+ if (b(i) /= i) stop 19
+ end do
+
+ deallocate (b)
+
+ ! Test the usage of an allocated declared array inside a host
+ ! function.
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 20
+ if (acc_is_present (b) .neqv. .true.) stop 21
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+
+ !$acc update host(b)
+
+ do i = 1, n
+ b(i) = fun2 (i)
+ end do
+
+ if (.not.acc_is_present (b)) stop 22
+
+ do i = 1, n
+ if (b(i) /= i*a) stop 23
+ end do
+
+ deallocate (a)
+ deallocate (b)
+end program test
+
+! Set each element in array 'b' at index i to a+i*2.
+
+subroutine sub1 ! { dg-warning "region is worker partitioned" }
+ use vars
+ implicit none
+ integer i
+ !$acc routine gang
+
+ !$acc loop
+ do i = 1, n
+ b(i) = a+i*2
+ end do
+end subroutine sub1
+
+! Allocate array 'b', and set it to all 1.0.
+
+subroutine sub2
+ use vars
+ use openacc
+ implicit none
+ integer i
+
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 24
+ if (acc_is_present (b) .neqv. .true.) stop 25
+
+ !$acc parallel loop
+ do i = 1, n
+ b(i) = 1.0
+ end do
+end subroutine sub2
+
+! Return b(i) * i;
+
+real*8 function fun1 (i)
+ use vars
+ implicit none
+ integer i
+ !$acc routine seq
+
+ fun1 = b(i) * i
+end function fun1
+
+! Return b(i) * i * a;
+
+real*8 function fun2 (i)
+ use vars
+ implicit none
+ integer i
+
+ fun2 = b(i) * i * a
+end function fun2
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90
new file mode 100644
index 00000000000..afbe52f0707
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90
@@ -0,0 +1,66 @@
+! Test declare create with allocatable arrays and scalars. The unused
+! declared array 'b' caused an ICE in the past.
+
+! { dg-do run }
+
+module vars
+ implicit none
+ integer, parameter :: n = 100
+ real*8, allocatable :: a, b(:)
+ !$acc declare create (a, b)
+end module vars
+
+program test
+ use vars
+ implicit none
+ integer :: i
+
+ interface
+ subroutine sub1
+ end subroutine sub1
+
+ subroutine sub2
+ end subroutine sub2
+
+ real*8 function fun1 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun1
+
+ real*8 function fun2 (ix)
+ integer ix
+ !$acc routine seq
+ end function fun2
+ end interface
+
+ if (allocated (a)) stop 1
+ if (allocated (b)) stop 2
+
+ ! Test the usage of an allocated declared array inside an acc
+ ! routine subroutine.
+
+ allocate (a)
+ allocate (b(n))
+
+ if (.not.allocated (b)) stop 3
+
+ call sub1
+
+ !$acc update self(a)
+ if (a /= 50) stop 4
+
+ deallocate (a)
+ deallocate (b)
+
+end program test
+
+! Set 'a' to 50.
+
+subroutine sub1
+ use vars
+ implicit none
+ integer i
+
+ a = 50
+ !$acc update device(a)
+end subroutine sub1
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2022-06-29 14:36 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-06-29 14:36 [gcc/devel/omp/gcc-12] Fortran "declare create"/allocate support for OpenACC Kwok Yeung
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).