+2015-11-22 James Norris <jnorris@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+
+ * dump-parse-tree.c (show_namespace): Handle declares.
+ * gfortran.h (struct symbol_attribute): New fields.
+ (enum gfc_omp_map_map): Add OMP_MAP_DEVICE_RESIDENT and OMP_MAP_LINK.
+ (OMP_LIST_LINK): New enum.
+ (struct gfc_oacc_declare): New structure.
+ (gfc_get_oacc_declare): New definition.
+ (struct gfc_namespace): Change type.
+ (enum gfc_exec_op): Add EXEC_OACC_DECLARE.
+ (struct gfc_code): New field.
+ * module.c (enum ab_attribute): Add AB_OACC_DECLARE_CREATE,
+ AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
+ AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK
+ (attr_bits): Add new initializers.
+ (mio_symbol_attribute): Handle new atributes.
+ * openmp.c (gfc_free_oacc_declare_clauses): New function.
+ (gfc_match_oacc_clause_link: Likewise.
+ (OMP_CLAUSE_LINK): New definition.
+ (gfc_match_omp_clauses): Handle OMP_CLAUSE_LINK.
+ (OACC_DECLARE_CLAUSES): Add OMP_CLAUSE_LINK
+ (gfc_match_oacc_declare): Add checking and module handling.
+ (resolve_omp_clauses): Add array initializer.
+ (gfc_resolve_oacc_declare): Reimplement.
+ * parse.c (case_decl): Add ST_OACC_DECLARE.
+ (parse_spec): Remove handling.
+ (parse_progunit): Remove handling.
+ * parse.h (struct gfc_state_data): Change type.
+ * resolve.c (gfc_resolve_blocks): Handle EXEC_OACC_DECLARE.
+ * st.c (gfc_free_statement): Handle EXEC_OACC_DECLARE.
+ * symbol.c (check_conflict): Add conflict checks.
+ (gfc_add_oacc_declare_create, gfc_add_oacc_declare_copyin,
+ gfc_add_oacc_declare_deviceptr, gfc_add_oacc_declare_device_resident):
+ New functions.
+ (gfc_copy_attr): Handle new symbols.
+ * trans-decl.c (add_clause, find_module_oacc_declare_clauses,
+ finish_oacc_declare): New functions.
+ (gfc_generate_function_code): Replace with call.
+ * trans-openmp.c (gfc_trans_oacc_declare): Reimplement.
+ (gfc_trans_oacc_directive): Handle EXEC_OACC_DECLARE.
+ * trans-stmt.c (gfc_trans_block_construct): Replace with call.
+ * trans-stmt.h (gfc_trans_oacc_declare): Remove argument.
+ * trans.c (trans_code): Handle EXEC_OACC_DECLARE.
+
2015-11-21 Steven G. Kargl <kargl@gcc.gnu.org>
* simplify.c (gfc_simplify_cshift): Work around bootstrap issues
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);
/* 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;
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
OMP_LIST_FROM,
OMP_LIST_REDUCTION,
OMP_LIST_DEVICE_RESIDENT,
+ OMP_LIST_LINK,
OMP_LIST_USE_DEVICE,
OMP_LIST_CACHE,
OMP_LIST_NUM
#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;
+ locus loc;
+}
+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
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;
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,
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;
/* 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 *);
bool gfc_is_reallocatable_lhs (gfc_expr *);
+/* trans-decl.c */
+
+void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool);
+
#endif /* GCC_GFORTRAN_H */
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[] =
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)
};
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 ();
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;
}
}
}
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)
return gfc_match (" %e )", &cp->gang_expr);
}
+static match
+gfc_match_oacc_clause_link (const char *str, gfc_omp_namelist **list)
+{
+ gfc_omp_namelist *head, *tail, *p;
+ locus old_loc;
+ char n[GFC_MAX_SYMBOL_LEN+1];
+ gfc_symbol *sym;
+ match m;
+ gfc_symtree *st;
+
+ old_loc = gfc_current_locus;
+
+ m = gfc_match (str);
+ if (m != MATCH_YES)
+ return m;
+
+ m = gfc_match (" (");
+
+ for (;;)
+ {
+ m = gfc_match_symbol (&sym, 0);
+ switch (m)
+ {
+ case MATCH_YES:
+ if (sym->attr.in_common)
+ {
+ gfc_error_now ("Variable at %C is an element of a COMMON block");
+ goto cleanup;
+ }
+ gfc_set_sym_referenced (sym);
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->sym = sym;
+ tail->expr = NULL;
+ tail->where = gfc_current_locus;
+ goto next_item;
+ case MATCH_NO:
+ break;
+
+ case MATCH_ERROR:
+ goto cleanup;
+ }
+
+ m = gfc_match (" / %n /", n);
+ if (m == MATCH_ERROR)
+ goto cleanup;
+ if (m == MATCH_NO || n[0] == '\0')
+ goto syntax;
+
+ st = gfc_find_symtree (gfc_current_ns->common_root, n);
+ if (st == NULL)
+ {
+ gfc_error ("COMMON block /%s/ not found at %C", n);
+ goto cleanup;
+ }
+
+ for (sym = st->n.common->head; sym; sym = sym->common_next)
+ {
+ gfc_set_sym_referenced (sym);
+ p = gfc_get_omp_namelist ();
+ if (head == NULL)
+ head = tail = p;
+ else
+ {
+ tail->next = p;
+ tail = tail->next;
+ }
+ tail->sym = sym;
+ tail->where = gfc_current_locus;
+ }
+
+ next_item:
+ if (gfc_match_char (')') == MATCH_YES)
+ break;
+ if (gfc_match_char (',') != MATCH_YES)
+ goto syntax;
+ }
+
+ if (gfc_match_omp_eos () != MATCH_YES)
+ {
+ gfc_error ("Unexpected junk after !$ACC DECLARE at %C");
+ goto cleanup;
+ }
+
+ while (*list)
+ list = &(*list)->next;
+ *list = head;
+ return MATCH_YES;
+
+syntax:
+ gfc_error ("Syntax error in !$ACC DECLARE list at %C");
+
+cleanup:
+ gfc_current_locus = old_loc;
+ return MATCH_ERROR;
+}
+
#define OMP_CLAUSE_PRIVATE ((uint64_t) 1 << 0)
#define OMP_CLAUSE_FIRSTPRIVATE ((uint64_t) 1 << 1)
#define OMP_CLAUSE_LASTPRIVATE ((uint64_t) 1 << 2)
#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. */
true)
== MATCH_YES)
continue;
+ if ((mask & OMP_CLAUSE_LINK)
+ && gfc_match_oacc_clause_link ("link (",
+ &c->lists[OMP_LIST_LINK])
+ == MATCH_YES)
+ continue;
if ((mask & OMP_CLAUSE_OACC_DEVICE)
&& gfc_match ("device ( ") == MATCH_YES
&& gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP],
| 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)
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;
+ locus where = gfc_current_locus;
+
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;
+
+ 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.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;
+ new_oc->loc = gfc_current_locus;
+ ns->oacc_declare = new_oc;
+
return MATCH_YES;
}
static const char *clause_names[]
= { "PRIVATE", "FIRSTPRIVATE", "LASTPRIVATE", "COPYPRIVATE", "SHARED",
"COPYIN", "UNIFORM", "ALIGNED", "LINEAR", "DEPEND", "MAP",
- "TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "USE_DEVICE",
+ "TO", "FROM", "REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE",
"CACHE" };
if (omp_clauses == NULL)
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;
+ for (oc = ns->oacc_declare; oc; oc = oc->next)
+ {
+ for (list = 0; list <= OMP_LIST_NUM; 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, &oc->loc);
+ continue;
+ }
- 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);
- }
+ if (n->expr && n->expr->ref->type == REF_ARRAY)
+ {
+ gfc_error ("Array sections: %qs not allowed in"
+ " $!ACC DECLARE at %L", n->sym->name, &oc->loc);
+ continue;
+ }
+ }
- 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 (n = oc->clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n; n = n->next)
+ check_array_not_assumed (n->sym, oc->loc, "DEVICE_RESIDENT");
+ }
- 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 (oc = ns->oacc_declare; oc; oc = oc->next)
+ {
+ for (list = 0; list <= OMP_LIST_NUM; 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, &oc->loc);
+ continue;
+ }
+ else
+ n->sym->mark = 1;
+ }
+ }
+ for (oc = ns->oacc_declare; oc; oc = oc->next)
+ {
+ for (list = 0; list <= OMP_LIST_NUM; 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)
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(). */
case ST_PUBLIC:
case ST_PRIVATE:
case ST_DERIVED_DECL:
- case ST_OACC_DECLARE:
case_decl:
if (p->state >= ORDER_EXEC)
goto order;
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;
}
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;
}
union
{
gfc_st_label *end_do_label;
- gfc_omp_clauses *oacc_declare_clauses;
+ gfc_oacc_declare *oacc_declare_clauses;
}
ext;
}
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;
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:
*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;
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);
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);
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);
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)
{
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)
{
}
+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)
{
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))
}
+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, gfc_symbol *sym, bool block)
+{
+ gfc_code *code;
+ gfc_oacc_declare *oc;
+ locus where = gfc_current_locus;
+ gfc_omp_clauses *omp_clauses = NULL;
+ gfc_omp_namelist *n, *p;
+
+ gfc_traverse_ns (ns, find_module_oacc_declare_clauses);
+
+ if (module_oacc_clauses && sym->attr.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)
+ {
+ if (oc->module_var)
+ continue;
+
+ if (block)
+ gfc_error ("Sorry, $!ACC DECLARE at %L is not allowed "
+ "in BLOCK construct", &oc->loc);
+
+
+ if (oc->clauses && oc->clauses->lists[OMP_LIST_MAP])
+ {
+ if (omp_clauses == NULL)
+ {
+ omp_clauses = oc->clauses;
+ continue;
+ }
+
+ for (n = oc->clauses->lists[OMP_LIST_MAP]; n; p = n, n = n->next)
+ ;
+
+ gcc_assert (p->next == NULL);
+
+ p->next = omp_clauses->lists[OMP_LIST_MAP];
+ omp_clauses = oc->clauses;
+ }
+ }
+
+ if (!omp_clauses)
+ return;
+
+ for (n = omp_clauses->lists[OMP_LIST_MAP]; n; n = n->next)
+ {
+ switch (n->u.map_op)
+ {
+ case OMP_MAP_DEVICE_RESIDENT:
+ n->u.map_op = OMP_MAP_FORCE_ALLOC;
+ break;
+
+ default:
+ break;
+ }
+ }
+
+ 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 = omp_clauses;
+
+ code->block = XCNEW (gfc_code);
+ code->block->op = EXEC_OACC_DECLARE;
+ code->block->loc = where;
+
+ if (ns->code)
+ code->block->next = ns->code;
+
+ ns->code = code;
+
+ return;
+}
+
+
/* Generate code for a function. */
void
if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !sym->attr.is_bind_c)
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, false);
tmp = gfc_trans_code (ns->code);
gfc_add_expr_to_block (&body, tmp);
}
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, oacc_clauses;
+ enum tree_code construct_code;
+
+ construct_code = OACC_DATA;
+
+ gfc_start_block (&block);
+
+ oacc_clauses = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses,
+ code->loc);
+ stmt = gfc_trans_omp_code (code->block->next, true);
+ stmt = build2_loc (input_location, construct_code, void_type_node, stmt,
+ oacc_clauses);
+ gfc_add_expr_to_block (&block, stmt);
+
+ return gfc_finish_block (&block);
}
tree
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 ();
}
exit_label = gfc_build_label_decl (NULL_TREE);
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, sym, true);
gfc_add_expr_to_block (&body, gfc_trans_code (ns->code));
gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label));
/* 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 *);
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;
+2015-11-22 James Norris <jnorris@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+
+ * gfortran.dg/goacc/declare-1.f95: Update test.
+ * gfortran.dg/goacc/declare-2.f95: New test.
+
2015-11-22 Bilyan Borisov <bilyan.borisov@arm.com>
* gcc.target/aarch64/simd/vmulx_lane_f32_1.c: New.
! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original" }
program test
implicit none
integer, value :: n
BLOCK
integer i
- !$acc declare copy(i)
+ !$acc declare copy(i) ! { dg-error "is not allowed" }
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" } }
--- /dev/null
+
+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
+
+module bmod
+
+ implicit none
+ integer :: a, b, c, d, e, f, g, h, i
+ common /data1/ a, b, c
+ common /data2/ d, e, f
+ common /data3/ g, h, i
+ !$acc declare link (a) ! { dg-error "element of a COMMON" }
+ !$acc declare link (/data1/)
+ !$acc declare link (a, b, c) ! { dg-error "element of a COMMON" }
+ !$acc declare link (/foo/) ! { dg-error "not found" }
+ !$acc declare device_resident (/data2/)
+ !$acc declare device_resident (/data3/) ! { dg-error "present on multiple clauses" }
+ !$acc declare device_resident (g, h, i)
+
+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 bsubr
+
+subroutine multiline
+ integer :: b(8)
+
+ !$acc declare copyin (b) ! { dg-error "present on multiple clauses" }
+ !$acc declare copyin (b)
+
+end subroutine multiline
+
+subroutine subarray
+ integer :: c(8)
+
+ !$acc declare copy (c(1:2)) ! { dg-error "Array sections: 'c' not allowed" }
+
+end subroutine subarray
+
+program test
+ integer :: a(8)
+
+ !$acc declare create (a) copyin (a) ! { dg-error "present on multiple clauses" }
+
+end program
+2015-11-22 James Norris <jnorris@codesourcery.com>
+ Cesar Philippidis <cesar@codesourcery.com>
+
+ * testsuite/libgomp.oacc-fortran/declare-1.f90: New test.
+ * testsuite/libgomp.oacc-fortran/declare-2.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/declare-3.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/declare-4.f90: Likewise.
+ * testsuite/libgomp.oacc-fortran/declare-5.f90: Likewise.
+
2015-11-20 Jakub Jelinek <jakub@redhat.com>
PR middle-end/68221
--- /dev/null
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module vars
+ implicit none
+ integer z
+ !$acc declare create (z)
+end module vars
+
+subroutine subr6 (a, d)
+ implicit none
+ 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)
+ implicit none
+ 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)
+ implicit none
+ 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)
+ implicit none
+ 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)
+ implicit none
+ 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)
+ implicit none
+ 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
+ implicit none
+ 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)
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ !$acc declare copy (a)
+ integer :: b(N)
+ integer :: c(N)
+ integer :: d(N)
+ integer :: i
+
+ 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
+ implicit none
+ integer, parameter :: N = 8
+ integer :: a(N)
+ integer :: b(N)
+ integer :: c(N)
+ integer :: d(N)
+ integer :: i
+
+ 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
--- /dev/null
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module globalvars
+ implicit none
+ integer a
+ !$acc declare create (a)
+end module globalvars
+
+program test
+ use globalvars
+ use openacc
+ implicit none
+
+ if (acc_is_present (a) .neqv. .true.) call abort
+
+end program test
--- /dev/null
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module globalvars
+ implicit none
+ real b
+ !$acc declare link (b)
+end module globalvars
+
+program test
+ use openacc
+ use globalvars
+ implicit none
+
+ 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
--- /dev/null
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module vars
+ implicit none
+ real b
+ !$acc declare create (b)
+end module vars
+
+program test
+ use vars
+ use openacc
+ implicit none
+ 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
--- /dev/null
+! { 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
+ implicit none
+ 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
projects / gcc.git / commitdiff