From a520239d83b3e44462a0e0900a32c4d3ed091c27 Mon Sep 17 00:00:00 2001 From: Julian Brown Date: Tue, 26 Feb 2019 15:48:00 -0800 Subject: [PATCH] Fortran "declare create"/allocate support for OpenACC 2018-10-04 Cesar Philippidis Julian Brown gcc/ * 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}. 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.c (gfc_array_allocate): Call gfc_trans_oacc_declare_allocate for decls that have oacc_declare_create attribute set. * trans-decl.c (add_attributes_to_decl): Enable lowering of OpenACC declare create, declare copyin and declare deviceptr clauses. (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. (finish_oacc_declare): Reset module_oacc_clauses before scanning each namespace. * 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. 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-array.f90: New test. * 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. (cherry picked from openacc-gcc-9-branch commit 965361e8890836b8e79da7d68fbf288f4c03dfc2) --- gcc/ChangeLog.omp | 15 ++ gcc/fortran/ChangeLog.omp | 29 +++ gcc/fortran/gfortran.h | 6 +- gcc/fortran/trans-array.c | 4 + gcc/fortran/trans-decl.c | 12 +- gcc/fortran/trans-openmp.c | 57 ++++- gcc/fortran/trans-stmt.c | 12 + gcc/fortran/trans.h | 1 + gcc/omp-low.c | 62 +++-- gcc/testsuite/ChangeLog.omp | 5 + .../goacc/declare-allocatable-1.f90 | 25 ++ gcc/tree-pretty-print.c | 6 + include/ChangeLog.omp | 6 + include/gomp-constants.h | 5 + libgomp/ChangeLog.omp | 13 ++ libgomp/oacc-mem.c | 28 +++ libgomp/oacc-parallel.c | 38 ++- .../allocatable-array-1.f90 | 30 +++ .../allocatable-scalar.f90 | 33 +++ .../declare-allocatable-1.f90 | 211 +++++++++++++++++ .../declare-allocatable-2.f90 | 48 ++++ .../declare-allocatable-3.f90 | 218 ++++++++++++++++++ .../declare-allocatable-4.f90 | 66 ++++++ 23 files changed, 893 insertions(+), 37 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/declare-allocatable-1.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/allocatable-array-1.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/allocatable-scalar.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-1.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-2.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-3.f90 create mode 100644 libgomp/testsuite/libgomp.oacc-fortran/declare-allocatable-4.f90 diff --git a/gcc/ChangeLog.omp b/gcc/ChangeLog.omp index f896d4023a74..13437ac9e7e4 100644 --- a/gcc/ChangeLog.omp +++ b/gcc/ChangeLog.omp @@ -1,3 +1,18 @@ +2018-10-04 Cesar Philippidis + Julian Brown + + * 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}. + 2018-12-22 Cesar Philippidis Julian Brown diff --git a/gcc/fortran/ChangeLog.omp b/gcc/fortran/ChangeLog.omp index 636587054902..fccade6b5a94 100644 --- a/gcc/fortran/ChangeLog.omp +++ b/gcc/fortran/ChangeLog.omp @@ -1,3 +1,32 @@ +2018-10-04 Cesar Philippidis + Julian Brown + + * 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 (add_attributes_to_decl): Enable lowering of OpenACC + declare create, declare copyin and declare deviceptr clauses. + (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. + (finish_oacc_declare): Reset module_oacc_clauses before scanning each + namespace. + * 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. + 2018-12-13 Cesar Philippidis Nathan Sidwell Julian Brown diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 5cd16e37fabc..8bf221b69829 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1205,7 +1205,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_linear_op @@ -1361,7 +1363,7 @@ typedef struct gfc_omp_clauses gfc_expr_list *tile_list; 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, nohost:1; + unsigned if_present:1, finalize:1, nohost:1, update_allocatable:1; locus loc; } diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 55879af9730f..7fb033c1721c 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5811,6 +5811,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; @@ -5825,6 +5826,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 { @@ -6009,6 +6011,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.c b/gcc/fortran/trans-decl.c index bde3ca3907f8..a941757cc0f6 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1403,7 +1403,10 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) if (sym_attr.omp_declare_target_link) list = tree_cons (get_identifier ("omp declare target link"), NULL_TREE, list); - else if (sym_attr.omp_declare_target) + else if (sym_attr.omp_declare_target + || sym_attr.oacc_declare_create + || sym_attr.oacc_declare_copyin + || sym_attr.oacc_declare_deviceptr) { tree c = NULL_TREE; if (sym_attr.oacc_function_nohost) @@ -6408,10 +6411,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; @@ -6440,6 +6443,8 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block) gfc_omp_clauses *omp_clauses = NULL; gfc_omp_namelist *n, *p; + module_oacc_clauses = NULL; + gfc_traverse_ns (ns, find_module_oacc_declare_clauses); if (module_oacc_clauses && sym->attr.flavor == FL_PROGRAM) @@ -6451,7 +6456,6 @@ finish_oacc_declare (gfc_namespace *ns, gfc_symbol *sym, bool block) new_oc->clauses = module_oacc_clauses; ns->oacc_declare = new_oc; - module_oacc_clauses = NULL; } if (!ns->oacc_declare) diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 25ebad325d9e..4668c63558c1 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -2192,9 +2192,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, (TREE_TYPE (TREE_TYPE (field))))) { tree orig_decl = decl; + enum gomp_map_kind gmk = GOMP_MAP_POINTER; + if (GFC_DECL_GET_SCALAR_ALLOCATABLE (field) + && n->sym->attr.oacc_declare_create) + { + if (clauses->update_allocatable) + gmk = GOMP_MAP_ALWAYS_POINTER; + else + gmk = GOMP_MAP_FIRSTPRIVATE_POINTER; + } node4 = build_omp_clause (input_location, OMP_CLAUSE_MAP); - OMP_CLAUSE_SET_MAP_KIND (node4, ptr_map_kind); + 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); @@ -2418,6 +2427,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 (); } @@ -3179,12 +3194,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; @@ -3200,8 +3217,7 @@ 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); + oacc_clauses = gfc_trans_omp_clauses (&block, clauses, code->loc); stmt = build1_loc (input_location, construct_code, void_type_node, oacc_clauses); gfc_add_expr_to_block (&block, stmt); @@ -5203,6 +5219,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.c b/gcc/fortran/trans-stmt.c index b9966ed93184..ea6f784dd071 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -6448,6 +6448,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 { @@ -6920,6 +6924,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) @@ -6973,6 +6981,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 9d9ac225b8dc..cb8c1af37992 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -782,6 +782,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); /* Runtime library function decls. */ extern GTY(()) tree gfor_fndecl_pause_numeric; diff --git a/gcc/omp-low.c b/gcc/omp-low.c index a4d60e64cd27..a28c61fdc5ae 100644 --- a/gcc/omp-low.c +++ b/gcc/omp-low.c @@ -1412,7 +1412,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) @@ -9424,7 +9425,7 @@ convert_to_firstprivate_int (tree var, gimple_seq *gs) { tree type = TREE_TYPE (var), new_type = NULL_TREE; - if (omp_is_reference (var)) + if (omp_is_reference (var) || POINTER_TYPE_P (type)) { type = TREE_TYPE (type); tree tmp = create_tmp_var (type); @@ -9449,7 +9450,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; @@ -9458,7 +9460,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); @@ -9469,16 +9495,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 @@ -9589,6 +9607,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) case GOMP_MAP_DYNAMIC_ARRAY_ALLOC: case GOMP_MAP_DYNAMIC_ARRAY_FORCE_ALLOC: case GOMP_MAP_DYNAMIC_ARRAY_FORCE_PRESENT: + case GOMP_MAP_DECLARE_ALLOCATE: + case GOMP_MAP_DECLARE_DEALLOCATE: case GOMP_MAP_LINK: case GOMP_MAP_ATTACH: case GOMP_MAP_DETACH: @@ -9673,7 +9693,8 @@ 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, omp_is_reference (var), + x = convert_from_firstprivate_int (x, TREE_TYPE (new_var), + omp_is_reference (var), &fplist); gimplify_assign (new_var, x, &fplist); map_cnt++; @@ -9689,13 +9710,19 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx) { gcc_assert (is_gimple_omp_oacc (ctx->stmt)); if (omp_is_reference (new_var) - && TREE_CODE (var_type) != POINTER_TYPE) + /* 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); @@ -9944,9 +9971,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_is_reference (var) ? TREE_TYPE (type) : type; + = omp_is_reference (new_var) ? TREE_TYPE (type) : type; if ((FLOAT_TYPE_P (inner_type) || ANY_INTEGRAL_TYPE_P (inner_type)) && tree_to_uhwi (TYPE_SIZE (inner_type)) <= POINTER_SIZE diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index a4afd356136a..8199f4db885f 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,8 @@ +2018-10-04 Cesar Philippidis + Julian Brown + + * gfortran.dg/goacc/declare-allocatable-1.f90: New test. + 2018-08-28 Julian Brown Cesar Philippidis 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 000000000000..5349e0d5b00e --- /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.c b/gcc/tree-pretty-print.c index 415b523a0f41..f74a927bbd6f 100644 --- a/gcc/tree-pretty-print.c +++ b/gcc/tree-pretty-print.c @@ -853,6 +853,12 @@ dump_omp_clause (pretty_printer *pp, tree clause, int spc, dump_flags_t flags) case GOMP_MAP_DYNAMIC_ARRAY_FORCE_PRESENT: pp_string (pp, "force_present,dynamic_array"); 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 addbefbd90df..3cc2e9ace8de 100644 --- a/include/ChangeLog.omp +++ b/include/ChangeLog.omp @@ -1,3 +1,9 @@ +2018-10-04 Cesar Philippidis + Julian Brown + + * gomp-constants.h (enum gomp_map_kind): Define + GOMP_MAP_DECLARE_{ALLOCATE,DEALLOCATE} and GOMP_MAP_FLAG_SPECIAL_4. + 2018-10-16 Chung-Lin Tang * gomp-constants.h (GOMP_MAP_FLAG_SPECIAL_3): Define. diff --git a/include/gomp-constants.h b/include/gomp-constants.h index 9c22f6e76300..2bbba6117123 100644 --- a/include/gomp-constants.h +++ b/include/gomp-constants.h @@ -152,6 +152,11 @@ enum gomp_map_kind | GOMP_MAP_FORCE_ALLOC), GOMP_MAP_DYNAMIC_ARRAY_FORCE_PRESENT = (GOMP_MAP_DYNAMIC_ARRAY | GOMP_MAP_FORCE_PRESENT), + /* 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), /* In OpenACC, attach a pointer to a mapped struct field. */ GOMP_MAP_ATTACH = (GOMP_MAP_DEEP_COPY | 0), /* In OpenACC, detach a pointer to a mapped struct field. */ diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp index acf674044f05..15f44cad3e04 100644 --- a/libgomp/ChangeLog.omp +++ b/libgomp/ChangeLog.omp @@ -1,3 +1,16 @@ +2018-10-04 Cesar Philippidis + Julian Brown + + * 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-array.f90: New test. + * 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. + 2018-12-22 Cesar Philippidis Julian Brown diff --git a/libgomp/oacc-mem.c b/libgomp/oacc-mem.c index 06801070d6e4..2ff8d7f91474 100644 --- a/libgomp/oacc-mem.c +++ b/libgomp/oacc-mem.c @@ -739,6 +739,34 @@ acc_update_self_async (void *h, size_t s, int async) update_dev_host (0, h, s, async); } +void +gomp_acc_declare_allocate (bool allocate, size_t mapnum, void **hostaddrs, + size_t *sizes, unsigned short *kinds) +{ + gomp_debug (0, " %s: processing\n", __FUNCTION__); + + if (allocate) + { + assert (mapnum == 3); + + /* Allocate memory for the array data. */ + uintptr_t data = (uintptr_t) acc_create (hostaddrs[0], sizes[0]); + + /* 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. */ + void *data = acc_deviceptr (hostaddrs[0]); + acc_free (data); + } + + gomp_debug (0, " %s: end\n", __FUNCTION__); +} + void gomp_acc_remove_pointer (struct gomp_device_descr *acc_dev, void **hostaddrs, size_t *sizes, unsigned short *kinds, int async, diff --git a/libgomp/oacc-parallel.c b/libgomp/oacc-parallel.c index 8407e3b34bc6..3369a3656b7a 100644 --- a/libgomp/oacc-parallel.c +++ b/libgomp/oacc-parallel.c @@ -69,6 +69,8 @@ find_pointer (int pos, size_t mapnum, unsigned short *kinds) case GOMP_MAP_FORCE_TOFROM: case GOMP_MAP_ALLOC: case GOMP_MAP_RELEASE: + case GOMP_MAP_DECLARE_ALLOCATE: + case GOMP_MAP_DECLARE_DEALLOCATE: { unsigned char kind1 = kinds[pos + 1] & 0xff; if (kind1 == GOMP_MAP_POINTER @@ -433,7 +435,8 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, || kind == GOMP_MAP_ATTACH || kind == GOMP_MAP_FORCE_TO || kind == GOMP_MAP_TO - || kind == GOMP_MAP_ALLOC) + || kind == GOMP_MAP_ALLOC + || kind == GOMP_MAP_DECLARE_ALLOCATE) { data_enter = true; break; @@ -444,7 +447,8 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, || kind == GOMP_MAP_DETACH || kind == GOMP_MAP_FORCE_DETACH || kind == GOMP_MAP_FROM - || kind == GOMP_MAP_FORCE_FROM) + || kind == GOMP_MAP_FORCE_FROM + || kind == GOMP_MAP_DECLARE_DEALLOCATE) break; gomp_fatal (">>>> GOACC_enter_exit_data UNHANDLED kind 0x%.2x", @@ -473,6 +477,7 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, { switch (kind) { + case GOMP_MAP_DECLARE_ALLOCATE: case GOMP_MAP_ALLOC: case GOMP_MAP_FORCE_ALLOC: acc_create_async (hostaddrs[i], sizes[i], async); @@ -502,13 +507,19 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, } else { - goacc_aq aq = get_goacc_asyncqueue (async); - for (int j = 0; j < 2; j++) - gomp_map_vars_async (acc_dev, aq, - (j == 0 || pointer == 2) ? 1 : 2, - &hostaddrs[i + j], NULL, - &sizes[i + j], &kinds[i + j], true, - GOMP_MAP_VARS_OPENACC_ENTER_DATA); + if (kind == GOMP_MAP_DECLARE_ALLOCATE) + gomp_acc_declare_allocate (true, pointer, &hostaddrs[i], + &sizes[i], &kinds[i]); + else + { + goacc_aq aq = get_goacc_asyncqueue (async); + for (int j = 0; j < 2; j++) + gomp_map_vars_async (acc_dev, aq, + (j == 0 || pointer == 2) ? 1 : 2, + &hostaddrs[i + j], NULL, + &sizes[i + j], &kinds[i + j], true, + GOMP_MAP_VARS_OPENACC_ENTER_DATA); + } /* Increment 'i' by two because OpenACC requires fortran arrays to be contiguous, so each PSET is associated with @@ -594,6 +605,7 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, case GOMP_MAP_FORCE_DETACH: case GOMP_MAP_FORCE_PRESENT: break; + case GOMP_MAP_DECLARE_DEALLOCATE: case GOMP_MAP_FROM: case GOMP_MAP_FORCE_FROM: if (finalize) @@ -645,8 +657,12 @@ GOACC_enter_exit_data (int flags_m, size_t mapnum, } else { - gomp_acc_remove_pointer (acc_dev, &hostaddrs[i], &sizes[i], - &kinds[i], async, finalize, pointer); + if (kind == GOMP_MAP_DECLARE_DEALLOCATE) + gomp_acc_declare_allocate (false, pointer, &hostaddrs[i], + &sizes[i], &kinds[i]); + else + gomp_acc_remove_pointer (acc_dev, &hostaddrs[i], &sizes[i], + &kinds[i], async, finalize, pointer); i += pointer - 1; } } diff --git a/libgomp/testsuite/libgomp.oacc-fortran/allocatable-array-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/allocatable-array-1.f90 new file mode 100644 index 000000000000..3758031dff4f --- /dev/null +++ b/libgomp/testsuite/libgomp.oacc-fortran/allocatable-array-1.f90 @@ -0,0 +1,30 @@ +! Ensure that dummy arguments of allocatable arrays don't cause +! "libgomp: [...] is not mapped" errors. + +! { dg-do run } + +program main + integer, parameter :: n = 40 + integer, allocatable :: ar(:,:,:) + integer :: i + + allocate (ar(1:n,0:n-1,0:n-1)) + !$acc enter data copyin (ar) + + !$acc update host (ar) + + !$acc update device (ar) + + call update_ar (ar, n) + + !$acc exit data copyout (ar) +end program main + +subroutine update_ar (ar, n) + integer :: n + integer, dimension (1:n,0:n-1,0:n-1) :: ar + + !$acc update host (ar) + + !$acc update device (ar) +end subroutine update_ar 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 000000000000..42b340822888 --- /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 000000000000..ec7f7c18ff32 --- /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 000000000000..df5ab26b8c26 --- /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 000000000000..9381b00343de --- /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 000000000000..afbe52f07072 --- /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 -- 2.47.2