@@ -2570,12 +2570,16 @@ show_namespace (gfc_namespace *ns)
for (eq = ns->equiv; eq; eq = eq->next)
show_equiv (eq);
- if (ns->oacc_declare_clauses)
+ if (ns->oacc_declare)
{
+ struct gfc_oacc_declare *decl;
/* Dump !$ACC DECLARE clauses. */
- show_indent ();
- fprintf (dumpfile, "!$ACC DECLARE");
- show_omp_clauses (ns->oacc_declare_clauses);
+ for (decl = ns->oacc_declare; decl; decl = decl->next)
+ {
+ show_indent ();
+ fprintf (dumpfile, "!$ACC DECLARE");
+ show_omp_clauses (decl->clauses);
+ }
}
fputc ('\n', dumpfile);
@@ -99,6 +99,8 @@ static const struct attribute_spec gfc_attribute_table[] =
affects_type_identity } */
{ "omp declare target", 0, 0, true, false, false,
gfc_handle_omp_declare_target_attribute, false },
+ { "oacc declare", 0, 0, true, false, false,
+ gfc_handle_omp_declare_target_attribute, false },
{ NULL, 0, 0, false, false, false, NULL, false }
};
@@ -841,6 +841,13 @@ typedef struct
/* Mentioned in OMP DECLARE TARGET. */
unsigned omp_declare_target:1;
+ /* Mentioned in OACC DECLARE. */
+ unsigned oacc_declare_create:1;
+ unsigned oacc_declare_copyin:1;
+ unsigned oacc_declare_deviceptr:1;
+ unsigned oacc_declare_device_resident:1;
+ unsigned oacc_declare_link:1;
+
/* Attributes set by compiler extensions (!GCC$ ATTRIBUTES). */
unsigned ext_attr:EXT_ATTR_NUM;
@@ -1106,7 +1113,9 @@ enum gfc_omp_map_op
OMP_MAP_FORCE_FROM,
OMP_MAP_FORCE_TOFROM,
OMP_MAP_FORCE_PRESENT,
- OMP_MAP_FORCE_DEVICEPTR
+ OMP_MAP_FORCE_DEVICEPTR,
+ OMP_MAP_DEVICE_RESIDENT,
+ OMP_MAP_LINK
};
/* For use in OpenMP clauses in case we need extra information
@@ -1148,6 +1157,7 @@ enum
OMP_LIST_FROM,
OMP_LIST_REDUCTION,
OMP_LIST_DEVICE_RESIDENT,
+ OMP_LIST_LINK,
OMP_LIST_USE_DEVICE,
OMP_LIST_CACHE,
OMP_LIST_NUM
@@ -1234,6 +1244,19 @@ gfc_omp_clauses;
#define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses)
+/* Node in the linked list used for storing !$oacc declare constructs. */
+
+typedef struct gfc_oacc_declare
+{
+ struct gfc_oacc_declare *next;
+ bool module_var;
+ gfc_omp_clauses *clauses;
+}
+gfc_oacc_declare;
+
+#define gfc_get_oacc_declare() XCNEW (gfc_oacc_declare)
+
+
/* Node in the linked list used for storing !$omp declare simd constructs. */
typedef struct gfc_omp_declare_simd
@@ -1645,8 +1668,8 @@ typedef struct gfc_namespace
this namespace. */
struct gfc_data *data, *old_data;
- /* !$ACC DECLARE clauses. */
- gfc_omp_clauses *oacc_declare_clauses;
+ /* !$ACC DECLARE. */
+ gfc_oacc_declare *oacc_declare;
gfc_charlen *cl_list, *old_cl_list;
@@ -2324,6 +2347,7 @@ enum gfc_exec_op
EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA,
EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE,
EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_ATOMIC,
+ EXEC_OACC_DECLARE,
EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER,
EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO,
EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE,
@@ -2405,6 +2429,7 @@ typedef struct gfc_code
struct gfc_code *which_construct;
int stop_code;
gfc_entry_list *entry;
+ gfc_oacc_declare *oacc_declare;
gfc_omp_clauses *omp_clauses;
const char *omp_name;
gfc_omp_namelist *omp_namelist;
@@ -2907,6 +2932,7 @@ gfc_expr *gfc_get_parentheses (gfc_expr *);
/* openmp.c */
struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; };
void gfc_free_omp_clauses (gfc_omp_clauses *);
+void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *);
void gfc_free_omp_declare_simd (gfc_omp_declare_simd *);
void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *);
void gfc_free_omp_udr (gfc_omp_udr *);
@@ -3224,4 +3250,8 @@ gfc_expr *gfc_simplify_ieee_functions (gfc_expr *);
bool gfc_is_reallocatable_lhs (gfc_expr *);
+/* trans-decl.c */
+
+void finish_oacc_declare (gfc_namespace *, enum sym_flavor);
+
#endif /* GCC_GFORTRAN_H */
@@ -1987,7 +1987,9 @@ enum ab_attribute
AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
- AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE
+ AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
+ AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
+ AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK
};
static const mstring attr_bits[] =
@@ -2044,6 +2046,11 @@ static const mstring attr_bits[] =
minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET),
minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY),
minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE),
+ minit ("OACC_DECLARE_CREATE", AB_OACC_DECLARE_CREATE),
+ minit ("OACC_DECLARE_COPYIN", AB_OACC_DECLARE_COPYIN),
+ minit ("OACC_DECLARE_DEVICEPTR", AB_OACC_DECLARE_DEVICEPTR),
+ minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT),
+ minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK),
minit (NULL, -1)
};
@@ -2231,6 +2238,16 @@ mio_symbol_attribute (symbol_attribute *attr)
MIO_NAME (ab_attribute) (AB_MODULE_PROCEDURE, attr_bits);
no_module_procedures = false;
}
+ if (attr->oacc_declare_create)
+ MIO_NAME (ab_attribute) (AB_OACC_DECLARE_CREATE, attr_bits);
+ if (attr->oacc_declare_copyin)
+ MIO_NAME (ab_attribute) (AB_OACC_DECLARE_COPYIN, attr_bits);
+ if (attr->oacc_declare_deviceptr)
+ MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICEPTR, attr_bits);
+ if (attr->oacc_declare_device_resident)
+ MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICE_RESIDENT, attr_bits);
+ if (attr->oacc_declare_link)
+ MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits);
mio_rparen ();
@@ -2403,6 +2420,21 @@ mio_symbol_attribute (symbol_attribute *attr)
case AB_MODULE_PROCEDURE:
attr->module_procedure =1;
break;
+ case AB_OACC_DECLARE_CREATE:
+ attr->oacc_declare_create = 1;
+ break;
+ case AB_OACC_DECLARE_COPYIN:
+ attr->oacc_declare_copyin = 1;
+ break;
+ case AB_OACC_DECLARE_DEVICEPTR:
+ attr->oacc_declare_deviceptr = 1;
+ break;
+ case AB_OACC_DECLARE_DEVICE_RESIDENT:
+ attr->oacc_declare_device_resident = 1;
+ break;
+ case AB_OACC_DECLARE_LINK:
+ attr->oacc_declare_link = 1;
+ break;
}
}
}
@@ -90,6 +90,25 @@ gfc_free_omp_clauses (gfc_omp_clauses *c)
free (c);
}
+/* Free oacc_declare structures. */
+
+void
+gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *oc)
+{
+ struct gfc_oacc_declare *decl = oc;
+
+ do
+ {
+ struct gfc_oacc_declare *next;
+
+ next = decl->next;
+ gfc_free_omp_clauses (decl->clauses);
+ free (decl);
+ decl = next;
+ }
+ while (decl);
+}
+
/* Free expression list. */
void
gfc_free_expr_list (gfc_expr_list *list)
@@ -453,6 +472,7 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
#define OMP_CLAUSE_DELETE ((uint64_t) 1 << 55)
#define OMP_CLAUSE_AUTO ((uint64_t) 1 << 56)
#define OMP_CLAUSE_TILE ((uint64_t) 1 << 57)
+#define OMP_CLAUSE_LINK ((uint64_t) 1 << 58)
/* Helper function for OpenACC and OpenMP clauses involving memory
mapping. */
@@ -691,6 +711,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
true)
== MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_LINK)
+ && gfc_match_omp_variable_list ("link (",
+ &c->lists[OMP_LIST_LINK],
+ true)
+ == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_OACC_DEVICE)
&& gfc_match ("device ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
@@ -1176,7 +1202,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
| OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \
| OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \
| OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \
- | OMP_CLAUSE_PRESENT_OR_CREATE)
+ | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_LINK)
#define OACC_UPDATE_CLAUSES \
(OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \
| OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT)
@@ -1293,12 +1319,86 @@ match
gfc_match_oacc_declare (void)
{
gfc_omp_clauses *c;
+ gfc_omp_namelist *n;
+ gfc_namespace *ns = gfc_current_ns;
+ gfc_oacc_declare *new_oc;
+ bool module_var = false;
+
if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true)
!= MATCH_YES)
return MATCH_ERROR;
- new_st.ext.omp_clauses = c;
- new_st.ext.omp_clauses->loc = gfc_current_locus;
+ for (n = c->lists[OMP_LIST_DEVICE_RESIDENT]; n != NULL; n = n->next)
+ n->sym->attr.oacc_declare_device_resident = 1;
+
+ for (n = c->lists[OMP_LIST_LINK]; n != NULL; n = n->next)
+ n->sym->attr.oacc_declare_link = 1;
+
+ for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next)
+ {
+ gfc_symbol *s = n->sym;
+ locus where = gfc_current_locus;
+
+ if (s->ns->proc_name && s->ns->proc_name->attr.proc == PROC_MODULE)
+ {
+ if (n->u.map_op != OMP_MAP_FORCE_ALLOC
+ && n->u.map_op != OMP_MAP_FORCE_TO)
+ {
+ gfc_error ("Invalid clause in module with $!ACC DECLARE at %L",
+ &where);
+ return MATCH_ERROR;
+ }
+
+ module_var = true;
+ }
+
+ if (s->attr.in_common)
+ {
+ gfc_error ("Variable in a common block with $!ACC DECLARE at %L",
+ &where);
+ return MATCH_ERROR;
+ }
+
+ if (s->attr.use_assoc)
+ {
+ gfc_error ("Variable is USE-associated with $!ACC DECLARE at %L",
+ &where);
+ return MATCH_ERROR;
+ }
+
+ if ((s->attr.dimension || s->attr.codimension)
+ && s->attr.dummy && s->as->type != AS_EXPLICIT)
+ {
+ gfc_error ("Assumed-size dummy array with $!ACC DECLARE at %L",
+ &where);
+ return MATCH_ERROR;
+ }
+
+ switch (n->u.map_op)
+ {
+ case OMP_MAP_FORCE_ALLOC:
+ s->attr.oacc_declare_create = 1;
+ break;
+
+ case OMP_MAP_FORCE_TO:
+ s->attr.oacc_declare_copyin = 1;
+ break;
+
+ case OMP_MAP_FORCE_DEVICEPTR:
+ s->attr.oacc_declare_deviceptr = 1;
+ break;
+
+ default:
+ break;
+ }
+ }
+
+ new_oc = gfc_get_oacc_declare ();
+ new_oc->next = ns->oacc_declare;
+ new_oc->module_var = module_var;
+ new_oc->clauses = c;
+ ns->oacc_declare = new_oc;
+
return MATCH_YES;
}
@@ -4613,44 +4713,80 @@ resolve_oacc_loop (gfc_code *code)
resolve_oacc_nested_loops (code, do_code, collapse, "collapsed");
}
-
void
gfc_resolve_oacc_declare (gfc_namespace *ns)
{
int list;
gfc_omp_namelist *n;
locus loc;
+ gfc_oacc_declare *oc;
- if (ns->oacc_declare_clauses == NULL)
+ if (ns->oacc_declare == NULL)
return;
- loc = ns->oacc_declare_clauses->loc;
+ loc = gfc_current_locus;
- for (list = OMP_LIST_DEVICE_RESIDENT;
- list <= OMP_LIST_DEVICE_RESIDENT; list++)
- for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
- {
- n->sym->mark = 0;
- if (n->sym->attr.flavor == FL_PARAMETER)
- gfc_error ("PARAMETER object %qs is not allowed at %L", n->sym->name, &loc);
- }
+ for (oc = ns->oacc_declare; oc; oc = oc->next)
+ {
+ for (list = OMP_LIST_DEVICE_RESIDENT;
+ list <= OMP_LIST_DEVICE_RESIDENT; list++)
+ for (n = oc->clauses->lists[list]; n; n = n->next)
+ {
+ n->sym->mark = 0;
+ if (n->sym->attr.flavor == FL_PARAMETER)
+ gfc_error ("PARAMETER object %qs is not allowed at %L",
+ n->sym->name, &loc);
+ }
- for (list = OMP_LIST_DEVICE_RESIDENT;
- list <= OMP_LIST_DEVICE_RESIDENT; list++)
- for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next)
- {
- if (n->sym->mark)
- gfc_error ("Symbol %qs present on multiple clauses at %L",
- n->sym->name, &loc);
- else
- n->sym->mark = 1;
- }
+ for (list = OMP_LIST_DEVICE_RESIDENT;
+ list <= OMP_LIST_DEVICE_RESIDENT; list++)
+ for (n = oc->clauses->lists[list]; n; n = n->next)
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol %qs present on multiple clauses at %L",
+ n->sym->name, &loc);
+ else
+ n->sym->mark = 1;
+ }
- for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n;
- n = n->next)
- check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT");
-}
+ for (n = oc->clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n; n = n->next)
+ check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT");
+
+ for (n = oc->clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+ {
+ if (n->expr && n->expr->ref->type == REF_ARRAY)
+ gfc_error ("Array sections: %qs not allowed in"
+ " $!ACC DECLARE at %L", n->sym->name, &loc);
+ }
+ }
+
+ for (oc = ns->oacc_declare; oc; oc = oc->next)
+ {
+ for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++)
+ for (n = oc->clauses->lists[list]; n; n = n->next)
+ n->sym->mark = 0;
+ }
+ for (oc = ns->oacc_declare; oc; oc = oc->next)
+ {
+ for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++)
+ for (n = oc->clauses->lists[list]; n; n = n->next)
+ {
+ if (n->sym->mark)
+ gfc_error ("Symbol %qs present on multiple clauses at %L",
+ n->sym->name, &loc);
+ else
+ n->sym->mark = 1;
+ }
+ }
+
+ for (oc = ns->oacc_declare; oc; oc = oc->next)
+ {
+ for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++)
+ for (n = oc->clauses->lists[list]; n; n = n->next)
+ n->sym->mark = 0;
+ }
+}
void
gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
@@ -1386,7 +1386,7 @@ next_statement (void)
case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \
case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \
case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_REDUCTION: \
- case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE
+ case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE: case ST_OACC_DECLARE
/* Block end statements. Errors associated with interchanging these
are detected in gfc_match_end(). */
@@ -2450,7 +2450,6 @@ verify_st_order (st_state *p, gfc_statement st, bool silent)
case ST_PUBLIC:
case ST_PRIVATE:
case ST_DERIVED_DECL:
- case ST_OACC_DECLARE:
case_decl:
if (p->state >= ORDER_EXEC)
goto order;
@@ -3362,19 +3361,6 @@ declSt:
st = next_statement ();
goto loop;
- case ST_OACC_DECLARE:
- if (!verify_st_order(&ss, st, false))
- {
- reject_statement ();
- st = next_statement ();
- goto loop;
- }
- if (gfc_state_stack->ext.oacc_declare_clauses == NULL)
- gfc_state_stack->ext.oacc_declare_clauses = new_st.ext.omp_clauses;
- accept_statement (st);
- st = next_statement ();
- goto loop;
-
default:
break;
}
@@ -5214,13 +5200,6 @@ contains:
done:
gfc_current_ns->code = gfc_state_stack->head;
- if (gfc_state_stack->state == COMP_PROGRAM
- || gfc_state_stack->state == COMP_MODULE
- || gfc_state_stack->state == COMP_SUBROUTINE
- || gfc_state_stack->state == COMP_FUNCTION
- || gfc_state_stack->state == COMP_BLOCK)
- gfc_current_ns->oacc_declare_clauses
- = gfc_state_stack->ext.oacc_declare_clauses;
}
@@ -48,7 +48,7 @@ typedef struct gfc_state_data
union
{
gfc_st_label *end_do_label;
- gfc_omp_clauses *oacc_declare_clauses;
+ gfc_oacc_declare *oacc_declare_clauses;
}
ext;
}
@@ -10646,6 +10646,7 @@ start:
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ATOMIC:
+ case EXEC_OACC_DECLARE:
gfc_resolve_oacc_directive (code, ns);
break;
@@ -185,6 +185,11 @@ gfc_free_statement (gfc_code *p)
gfc_free_forall_iterator (p->ext.forall_iterator);
break;
+ case EXEC_OACC_DECLARE:
+ if (p->ext.oacc_declare)
+ gfc_free_oacc_declare_clauses (p->ext.oacc_declare);
+ break;
+
case EXEC_OACC_PARALLEL_LOOP:
case EXEC_OACC_PARALLEL:
case EXEC_OACC_KERNELS_LOOP:
@@ -375,6 +375,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
*contiguous = "CONTIGUOUS", *generic = "GENERIC";
static const char *threadprivate = "THREADPRIVATE";
static const char *omp_declare_target = "OMP DECLARE TARGET";
+ static const char *oacc_declare_copyin = "OACC DECLARE COPYIN";
+ static const char *oacc_declare_create = "OACC DECLARE CREATE";
+ static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR";
+ static const char *oacc_declare_device_resident =
+ "OACC DECLARE DEVICE_RESIDENT";
const char *a1, *a2;
int standard;
@@ -511,6 +516,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (in_equivalence, allocatable);
conf (in_equivalence, threadprivate);
conf (in_equivalence, omp_declare_target);
+ conf (in_equivalence, oacc_declare_create);
+ conf (in_equivalence, oacc_declare_copyin);
+ conf (in_equivalence, oacc_declare_deviceptr);
+ conf (in_equivalence, oacc_declare_device_resident);
conf (dummy, result);
conf (entry, result);
@@ -560,6 +569,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (cray_pointee, in_equivalence);
conf (cray_pointee, threadprivate);
conf (cray_pointee, omp_declare_target);
+ conf (cray_pointee, oacc_declare_create);
+ conf (cray_pointee, oacc_declare_copyin);
+ conf (cray_pointee, oacc_declare_deviceptr);
+ conf (cray_pointee, oacc_declare_device_resident);
conf (data, dummy);
conf (data, function);
@@ -614,6 +627,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf (proc_pointer, abstract)
conf (entry, omp_declare_target)
+ conf (entry, oacc_declare_create)
+ conf (entry, oacc_declare_copyin)
+ conf (entry, oacc_declare_deviceptr)
+ conf (entry, oacc_declare_device_resident)
a1 = gfc_code2string (flavors, attr->flavor);
@@ -651,6 +668,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (subroutine);
conf2 (threadprivate);
conf2 (omp_declare_target);
+ conf2 (oacc_declare_create);
+ conf2 (oacc_declare_copyin);
+ conf2 (oacc_declare_deviceptr);
+ conf2 (oacc_declare_device_resident);
if (attr->access == ACCESS_PUBLIC || attr->access == ACCESS_PRIVATE)
{
@@ -733,6 +754,10 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
conf2 (threadprivate);
conf2 (result);
conf2 (omp_declare_target);
+ conf2 (oacc_declare_create);
+ conf2 (oacc_declare_copyin);
+ conf2 (oacc_declare_deviceptr);
+ conf2 (oacc_declare_device_resident);
if (attr->intent != INTENT_UNKNOWN)
{
@@ -1244,6 +1269,62 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name,
bool
+gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, locus *where)
+{
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->oacc_declare_create)
+ return true;
+
+ attr->oacc_declare_create = 1;
+ return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name, locus *where)
+{
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->oacc_declare_copyin)
+ return true;
+
+ attr->oacc_declare_copyin = 1;
+ return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name, locus *where)
+{
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->oacc_declare_deviceptr)
+ return true;
+
+ attr->oacc_declare_deviceptr = 1;
+ return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name, locus *where)
+{
+ if (check_used (attr, name, where))
+ return false;
+
+ if (attr->oacc_declare_device_resident)
+ return true;
+
+ attr->oacc_declare_device_resident = 1;
+ return check_conflict (attr, name, where);
+}
+
+
+bool
gfc_add_target (symbol_attribute *attr, locus *where)
{
@@ -1820,6 +1901,18 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
if (src->omp_declare_target
&& !gfc_add_omp_declare_target (dest, NULL, where))
goto fail;
+ if (src->oacc_declare_create
+ && !gfc_add_oacc_declare_create (dest, NULL, where))
+ goto fail;
+ if (src->oacc_declare_copyin
+ && !gfc_add_oacc_declare_copyin (dest, NULL, where))
+ goto fail;
+ if (src->oacc_declare_deviceptr
+ && !gfc_add_oacc_declare_deviceptr (dest, NULL, where))
+ goto fail;
+ if (src->oacc_declare_device_resident
+ && !gfc_add_oacc_declare_device_resident (dest, NULL, where))
+ goto fail;
if (src->target && !gfc_add_target (dest, where))
goto fail;
if (src->dummy && !gfc_add_dummy (dest, NULL, where))
@@ -1307,6 +1307,15 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
list = tree_cons (get_identifier ("omp declare target"),
NULL_TREE, list);
+ if (sym_attr.oacc_declare_create
+ || sym_attr.oacc_declare_copyin
+ || sym_attr.oacc_declare_deviceptr
+ || sym_attr.oacc_declare_device_resident
+ || sym_attr.oacc_declare_link)
+ {
+ list = tree_cons (get_identifier ("oacc declare"),
+ NULL_TREE, list);
+ }
return list;
}
@@ -5761,6 +5770,258 @@ is_ieee_module_used (gfc_namespace *ns)
return seen_ieee_symbol;
}
+static struct oacc_return
+{
+ gfc_code *code;
+ struct oacc_return *next;
+} *oacc_returns;
+
+static void
+find_oacc_return (gfc_code *code)
+{
+ if (code->next)
+ {
+ if (code->next->op == EXEC_RETURN
+ || code->next->op == EXEC_END_PROCEDURE)
+ {
+ struct oacc_return *r;
+
+ r = XCNEW (struct oacc_return);
+ r->code = code;
+ r->next = NULL;
+
+ if (oacc_returns)
+ r->next = oacc_returns;
+
+ oacc_returns = r;
+ }
+ else
+ {
+ find_oacc_return (code->next);
+ }
+ }
+ else if (code->block)
+ find_oacc_return (code->block);
+ else
+ {
+ struct oacc_return *r;
+
+ r = XCNEW (struct oacc_return);
+ r->code = code;
+ r->next = NULL;
+
+ if (oacc_returns)
+ r->next = oacc_returns;
+
+ oacc_returns = r;
+ }
+
+ return;
+}
+
+static gfc_omp_clauses *module_oacc_clauses;
+
+static void
+add_clause (gfc_symbol *sym, gfc_omp_map_op map_op)
+{
+ gfc_omp_namelist *n;
+
+ n = gfc_get_omp_namelist ();
+ n->sym = sym;
+ n->u.map_op = map_op;
+
+ if (!module_oacc_clauses)
+ module_oacc_clauses = gfc_get_omp_clauses ();
+
+ if (module_oacc_clauses->lists[OMP_LIST_MAP])
+ n->next = module_oacc_clauses->lists[OMP_LIST_MAP];
+
+ module_oacc_clauses->lists[OMP_LIST_MAP] = n;
+}
+
+
+static void
+find_module_oacc_declare_clauses (gfc_symbol *sym)
+{
+ if (sym->attr.use_assoc)
+ {
+ gfc_omp_map_op map_op;
+
+ if (sym->attr.oacc_declare_create)
+ map_op = OMP_MAP_FORCE_ALLOC;
+
+ if (sym->attr.oacc_declare_copyin)
+ map_op = OMP_MAP_FORCE_TO;
+
+ if (sym->attr.oacc_declare_deviceptr)
+ map_op = OMP_MAP_FORCE_DEVICEPTR;
+
+ if (sym->attr.oacc_declare_device_resident)
+ map_op = OMP_MAP_DEVICE_RESIDENT;
+
+ if (sym->attr.oacc_declare_create
+ || sym->attr.oacc_declare_copyin
+ || sym->attr.oacc_declare_deviceptr
+ || sym->attr.oacc_declare_device_resident)
+ {
+ sym->attr.referenced = 1;
+ add_clause (sym, map_op);
+ }
+ }
+}
+
+void
+finish_oacc_declare (gfc_namespace *ns, enum sym_flavor flavor)
+{
+ gfc_code *code;
+ gfc_oacc_declare *oc;
+ gfc_omp_namelist *n;
+ locus where = gfc_current_locus;
+ gfc_omp_clauses *ret_clauses = NULL;
+
+ gfc_traverse_ns (ns, find_module_oacc_declare_clauses);
+
+ if (module_oacc_clauses && flavor == FL_PROGRAM)
+ {
+ gfc_oacc_declare *new_oc;
+
+ new_oc = gfc_get_oacc_declare ();
+ new_oc->next = ns->oacc_declare;
+ new_oc->clauses = module_oacc_clauses;
+
+ ns->oacc_declare = new_oc;
+ module_oacc_clauses = NULL;
+ }
+
+ if (!ns->oacc_declare)
+ return;
+
+ for (oc = ns->oacc_declare; oc; oc = oc->next)
+ {
+ gfc_omp_clauses *omp_clauses;
+
+ if (oc->module_var)
+ continue;
+
+ if (oc->clauses)
+ {
+ code = XCNEW (gfc_code);
+ code->op = EXEC_OACC_DECLARE;
+ code->loc = where;
+
+ omp_clauses = oc->clauses;
+
+ for (n = omp_clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+ {
+ bool ret = false;
+ gfc_omp_map_op new_op;
+
+ switch (n->u.map_op)
+ {
+ case OMP_MAP_ALLOC:
+ case OMP_MAP_FORCE_ALLOC:
+ new_op = OMP_MAP_FORCE_DEALLOC;
+ ret = true;
+ break;
+
+ case OMP_MAP_DEVICE_RESIDENT:
+ n->u.map_op = OMP_MAP_FORCE_ALLOC;
+ new_op = OMP_MAP_FORCE_DEALLOC;
+ ret = true;
+ break;
+
+ case OMP_MAP_FORCE_FROM:
+ n->u.map_op = OMP_MAP_FORCE_ALLOC;
+ new_op = OMP_MAP_FORCE_FROM;
+ ret = true;
+ break;
+
+ case OMP_MAP_FORCE_TO:
+ new_op = OMP_MAP_FORCE_DEALLOC;
+ ret = true;
+ break;
+
+ case OMP_MAP_FORCE_TOFROM:
+ n->u.map_op = OMP_MAP_FORCE_TO;
+ new_op = OMP_MAP_FORCE_FROM;
+ ret = true;
+ break;
+
+ case OMP_MAP_FROM:
+ n->u.map_op = OMP_MAP_FORCE_ALLOC;
+ new_op = OMP_MAP_FROM;
+ ret = true;
+ break;
+
+ case OMP_MAP_FORCE_DEVICEPTR:
+ case OMP_MAP_FORCE_PRESENT:
+ case OMP_MAP_LINK:
+ case OMP_MAP_TO:
+ break;
+
+ case OMP_MAP_TOFROM:
+ n->u.map_op = OMP_MAP_TO;
+ new_op = OMP_MAP_FROM;
+ ret = true;
+ break;
+
+ default:
+ gcc_unreachable ();
+ break;
+ }
+
+ if (ret)
+ {
+ gfc_omp_namelist *new_n;
+
+ new_n = gfc_get_omp_namelist ();
+ new_n->sym = n->sym;
+ new_n->u.map_op = new_op;
+
+ if (!ret_clauses)
+ ret_clauses = gfc_get_omp_clauses ();
+
+ if (ret_clauses->lists[OMP_LIST_MAP])
+ new_n->next = ret_clauses->lists[OMP_LIST_MAP];
+
+ ret_clauses->lists[OMP_LIST_MAP] = new_n;
+ ret = false;
+ }
+ }
+
+ code->ext.oacc_declare = gfc_get_oacc_declare ();
+ code->ext.oacc_declare->clauses = omp_clauses;
+
+ if (ns->code)
+ code->next = ns->code;
+ ns->code = code;
+ }
+ }
+
+ find_oacc_return (ns->code);
+
+ while (oacc_returns)
+ {
+ struct oacc_return *r;
+
+ r = oacc_returns;
+
+ code = XCNEW (gfc_code);
+ code->op = EXEC_OACC_DECLARE;
+ code->loc = where;
+
+ code->ext.oacc_declare = gfc_get_oacc_declare ();
+ code->ext.oacc_declare->clauses = ret_clauses;
+ code->next = r->code->next;
+ r->code->next = code;
+
+ oacc_returns = r->next;
+ free (r);
+ }
+
+ return;
+}
+
/* Generate code for a function. */
@@ -5899,11 +6160,7 @@ gfc_generate_function_code (gfc_namespace * ns)
add_argument_checking (&body, sym);
/* Generate !$ACC DECLARE directive. */
- if (ns->oacc_declare_clauses)
- {
- tree tmp = gfc_trans_oacc_declare (&body, ns);
- gfc_add_expr_to_block (&body, tmp);
- }
+ finish_oacc_declare (ns, sym->attr.flavor);
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
@@ -1925,6 +1925,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
if (!n->sym->attr.referenced)
continue;
+ if (n->sym->attr.use_assoc && n->sym->attr.oacc_declare_link)
+ continue;
+
tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP);
tree node2 = NULL_TREE;
tree node3 = NULL_TREE;
@@ -4423,13 +4426,24 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses)
}
tree
-gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *ns)
+gfc_trans_oacc_declare (gfc_code *code)
{
- tree oacc_clauses;
- oacc_clauses = gfc_trans_omp_clauses (block, ns->oacc_declare_clauses,
- ns->oacc_declare_clauses->loc);
- return build1_loc (ns->oacc_declare_clauses->loc.lb->location,
- OACC_DECLARE, void_type_node, oacc_clauses);
+ stmtblock_t block;
+ tree stmt, c;
+ enum tree_code construct_code;
+
+ gfc_start_block (&block);
+
+ construct_code = OACC_DECLARE;
+
+ gfc_start_block (&block);
+ c = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses,
+ code->loc);
+
+ stmt = build1_loc (input_location, construct_code, void_type_node, c);
+ gfc_add_expr_to_block (&block, stmt);
+
+ return gfc_finish_block (&block);
}
tree
@@ -4457,6 +4471,8 @@ gfc_trans_oacc_directive (gfc_code *code)
return gfc_trans_oacc_wait_directive (code);
case EXEC_OACC_ATOMIC:
return gfc_trans_omp_atomic (code);
+ case EXEC_OACC_DECLARE:
+ return gfc_trans_oacc_declare (code);
default:
gcc_unreachable ();
}
@@ -1579,11 +1579,7 @@ gfc_trans_block_construct (gfc_code* code)
code->exit_label = exit_label;
/* Generate !$ACC DECLARE directive. */
- if (ns->oacc_declare_clauses)
- {
- tree tmp = gfc_trans_oacc_declare (&body, ns);
- gfc_add_expr_to_block (&body, tmp);
- }
+ finish_oacc_declare (ns, FL_UNKNOWN);
gfc_add_expr_to_block (&body, gfc_trans_code (ns->code));
gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label));
@@ -67,7 +67,7 @@ void gfc_trans_omp_declare_simd (gfc_namespace *);
/* trans-openacc.c */
tree gfc_trans_oacc_directive (gfc_code *);
-tree gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *);
+tree gfc_trans_oacc_declare (gfc_namespace *);
/* trans-io.c */
tree gfc_trans_open (gfc_code *);
@@ -1904,6 +1904,7 @@ trans_code (gfc_code * code, tree cond)
case EXEC_OACC_ENTER_DATA:
case EXEC_OACC_EXIT_DATA:
case EXEC_OACC_ATOMIC:
+ case EXEC_OACC_DECLARE:
res = gfc_trans_oacc_directive (code);
break;
@@ -15,5 +15,4 @@ contains
END BLOCK
end function foo
end program test
-! { dg-prune-output "unimplemented" }
-! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_tofrom:i\\)" 2 "original" } }
+! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_to:i\\)" 2 "original" } }
@@ -0,0 +1,44 @@
+
+module amod
+
+contains
+
+subroutine asubr (b)
+ implicit none
+ integer :: b(8)
+
+ !$acc declare copy (b) ! { dg-error "Invalid clause in module" }
+ !$acc declare copyout (b) ! { dg-error "Invalid clause in module" }
+ !$acc declare present (b) ! { dg-error "Invalid clause in module" }
+ !$acc declare present_or_copy (b) ! { dg-error "Invalid clause in module" }
+ !$acc declare present_or_copyin (b) ! { dg-error "Invalid clause in module" }
+ !$acc declare present_or_copyout (b) ! { dg-error "Invalid clause in module" }
+ !$acc declare present_or_create (b) ! { dg-error "Invalid clause in module" }
+ !$acc declare deviceptr (b) ! { dg-error "Invalid clause in module" }
+ !$acc declare create (b) copyin (b) ! { dg-error "present on multiple clauses" }
+
+end subroutine
+
+end module
+
+subroutine bsubr (foo)
+ implicit none
+
+ integer, dimension (:) :: foo
+
+ !$acc declare copy (foo) ! { dg-error "assumed-size dummy array" }
+ !$acc declare copy (foo(1:2)) ! { dg-error "assumed-size dummy array" }
+
+end subroutine
+
+program test
+ integer :: a(8)
+ integer :: b(8)
+ integer :: c(8)
+
+ !$acc declare create (a) copyin (a) ! { dg-error "present on multiple clauses" }
+ !$acc declare copyin (b)
+ !$acc declare copyin (b) ! { dg-error "present on multiple clauses" }
+ !$acc declare copy (c(1:2)) ! { dg-error "Array sections: 'c' not allowed" }
+
+end program
@@ -0,0 +1,236 @@
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module vars
+ integer z
+ !$acc declare create (z)
+end module vars
+
+subroutine subr6 (a, d)
+ integer, parameter :: N = 8
+ integer :: i
+ integer :: a(N)
+ !$acc declare deviceptr (a)
+ integer :: d(N)
+
+ i = 0
+
+ !$acc parallel copy (d)
+ do i = 1, N
+ d(i) = a(i) + a(i)
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr5 (a, b, c, d)
+ integer, parameter :: N = 8
+ integer :: i
+ integer :: a(N)
+ !$acc declare present_or_copyin (a)
+ integer :: b(N)
+ !$acc declare present_or_create (b)
+ integer :: c(N)
+ !$acc declare present_or_copyout (c)
+ integer :: d(N)
+ !$acc declare present_or_copy (d)
+
+ i = 0
+
+ !$acc parallel
+ do i = 1, N
+ b(i) = a(i)
+ c(i) = b(i)
+ d(i) = d(i) + b(i)
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr4 (a, b)
+ integer, parameter :: N = 8
+ integer :: i
+ integer :: a(N)
+ !$acc declare present (a)
+ integer :: b(N)
+ !$acc declare copyout (b)
+
+ i = 0
+
+ !$acc parallel
+ do i = 1, N
+ b(i) = a(i)
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr3 (a, c)
+ integer, parameter :: N = 8
+ integer :: i
+ integer :: a(N)
+ !$acc declare present (a)
+ integer :: c(N)
+ !$acc declare copyin (c)
+
+ i = 0
+
+ !$acc parallel
+ do i = 1, N
+ a(i) = c(i)
+ c(i) = 0
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr2 (a, b, c)
+ integer, parameter :: N = 8
+ integer :: i
+ integer :: a(N)
+ !$acc declare present (a)
+ integer :: b(N)
+ !$acc declare create (b)
+ integer :: c(N)
+ !$acc declare copy (c)
+
+ i = 0
+
+ !$acc parallel
+ do i = 1, N
+ b(i) = a(i)
+ c(i) = b(i) + c(i) + 1
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine subr1 (a)
+ integer, parameter :: N = 8
+ integer :: i
+ integer :: a(N)
+ !$acc declare present (a)
+
+ i = 0
+
+ !$acc parallel
+ do i = 1, N
+ a(i) = a(i) + 1
+ end do
+ !$acc end parallel
+
+end subroutine
+
+subroutine test (a, e)
+ use openacc
+ logical :: e
+ integer, parameter :: N = 8
+ integer :: a(N)
+
+ if (acc_is_present (a) .neqv. e) call abort
+
+end subroutine
+
+subroutine subr0 (a, b, c, d)
+ integer, parameter :: N = 8
+ integer :: a(N)
+ !$acc declare copy (a)
+ integer :: b(N)
+ integer :: c(N)
+ integer :: d(N)
+
+ call test (a, .true.)
+ call test (b, .false.)
+ call test (c, .false.)
+
+ call subr1 (a)
+
+ call test (a, .true.)
+ call test (b, .false.)
+ call test (c, .false.)
+
+ call subr2 (a, b, c)
+
+ call test (a, .true.)
+ call test (b, .false.)
+ call test (c, .false.)
+
+ do i = 1, N
+ if (c(i) .ne. 8) call abort
+ end do
+
+ call subr3 (a, c)
+
+ call test (a, .true.)
+ call test (b, .false.)
+ call test (c, .false.)
+
+ do i = 1, N
+ if (a(i) .ne. 2) call abort
+ if (c(i) .ne. 8) call abort
+ end do
+
+ call subr4 (a, b)
+
+ call test (a, .true.)
+ call test (b, .false.)
+ call test (c, .false.)
+
+ do i = 1, N
+ if (b(i) .ne. 8) call abort
+ end do
+
+ call subr5 (a, b, c, d)
+
+ call test (a, .true.)
+ call test (b, .false.)
+ call test (c, .false.)
+ call test (d, .false.)
+
+ do i = 1, N
+ if (c(i) .ne. 8) call abort
+ if (d(i) .ne. 13) call abort
+ end do
+
+ call subr6 (a, d)
+
+ call test (a, .true.)
+ call test (d, .false.)
+
+ do i = 1, N
+ if (d(i) .ne. 16) call abort
+ end do
+
+end subroutine
+
+program main
+ use vars
+ use openacc
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: c(N)
+ integer :: d(N)
+
+ a(:) = 2
+ b(:) = 3
+ c(:) = 4
+ d(:) = 5
+
+ if (acc_is_present (z) .neqv. .true.) call abort
+
+ call subr0 (a, b, c, d)
+
+ call test (a, .false.)
+ call test (b, .false.)
+ call test (c, .false.)
+ call test (d, .false.)
+
+ do i = 1, N
+ if (a(i) .ne. 8) call abort
+ if (b(i) .ne. 8) call abort
+ if (c(i) .ne. 8) call abort
+ if (d(i) .ne. 16) call abort
+ end do
+
+
+end program
@@ -0,0 +1,14 @@
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module globalvars
+ integer a
+ !$acc declare create (a)
+end module globalvars
+
+program test
+ use globalvars
+ use openacc
+
+ if (acc_is_present (a) .neqv. .true.) call abort
+
+end program test
@@ -0,0 +1,65 @@
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module globalvars
+ real b
+ !$acc declare link (b)
+end module globalvars
+
+program test
+ use openacc
+
+ real a
+ real c
+ !$acc declare link (c)
+
+ if (acc_is_present (b) .neqv. .false.) call abort
+ if (acc_is_present (c) .neqv. .false.) call abort
+
+ a = 0.0
+ b = 1.0
+
+ !$acc parallel copy (a) copyin (b)
+ b = b + 4.0
+ a = b
+ !$acc end parallel
+
+ if (a .ne. 5.0) call abort
+
+ if (acc_is_present (b) .neqv. .false.) call abort
+
+ a = 0.0
+
+ !$acc parallel copy (a) create (b)
+ b = 4.0
+ a = b
+ !$acc end parallel
+
+ if (a .ne. 4.0) call abort
+
+ if (acc_is_present (b) .neqv. .false.) call abort
+
+ a = 0.0
+
+ !$acc parallel copy (a) copy (b)
+ b = 4.0
+ a = b
+ !$acc end parallel
+
+ if (a .ne. 4.0) call abort
+ if (b .ne. 4.0) call abort
+
+ if (acc_is_present (b) .neqv. .false.) call abort
+
+ a = 0.0
+
+ !$acc parallel copy (a) copy (b) copy (c)
+ b = 4.0
+ c = b
+ a = c
+ !$acc end parallel
+
+ if (a .ne. 4.0) call abort
+
+ if (acc_is_present (b) .neqv. .false.) call abort
+
+end program test
@@ -0,0 +1,27 @@
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module vars
+ real b
+ !$acc declare create (b)
+end module vars
+
+program test
+ use vars
+ use openacc
+ real a
+
+ if (acc_is_present (b) .neqv. .true.) call abort
+
+ a = 2.0
+
+ !$acc parallel copy (a)
+ b = a
+ a = 1.0
+ a = a + b
+ !$acc end parallel
+
+ if (acc_is_present (b) .neqv. .true.) call abort
+
+ if (a .ne. 3.0) call abort
+
+end program test
@@ -0,0 +1,28 @@
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module vars
+ implicit none
+ real b
+ !$acc declare device_resident (b)
+end module vars
+
+program test
+ use vars
+ use openacc
+ real a
+
+ if (acc_is_present (b) .neqv. .true.) call abort
+
+ a = 2.0
+
+ !$acc parallel copy (a)
+ b = a
+ a = 1.0
+ a = a + b
+ !$acc end parallel
+
+ if (acc_is_present (b) .neqv. .true.) call abort
+
+ if (a .ne. 3.0) call abort
+
+end program test