This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
| Other format: | [Raw text] | |
Jakub, Here's the updated version of the Fortran changes. More test cases have been added as well as the issues that Cesar pointed on in error checking have been addressed (Thanks). I've also addressed the issue, described below, in dealing with declare directives when found within a BLOCK construct. On 11/06/2015 01:49 PM, Jakub Jelinek wrote:
On Fri, Nov 06, 2015 at 01:45:09PM -0600, James Norris wrote:Okay, I'll fix this. After fixing, OK to commit? Thank you for taking the time for the review.Well, isn't this patch really dependent on the other one? Also, wonder about BLOCK stmt in Fortran, that can give you variables that don't live through the whole function, but only a portion of it even in Fortran.
On 11/18/2015 02:09 PM, Cesar Philippidis wrote: > On 11/08/2015 08:53 PM, James Norris wrote: > > > What block stmt? The most recent version of Fortran OpenACC 2.0a > supports is 2003. The block construct is a 2008 feature. I don't think > that's applicable to this version. Jim, maybe you should add an error > message for variables defined in blocks. > > Thinking about this some more, I wonder if we should emit an error if > any acc constructs are used inside blocks? That's probably overly > pessimistic though. Thanks! Jim
Attachment:
ChangeLog
Description: Text document
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 83ecbaa..48476af 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -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);
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e13b4d4..5487c93 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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,20 @@ 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;
+ 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
@@ -1645,8 +1669,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 +2348,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 +2430,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 +2933,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 +3251,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 *, gfc_symbol *, bool);
+
#endif /* GCC_GFORTRAN_H */
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 54777f7..6b544ee 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1986,7 +1986,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[] =
@@ -2043,6 +2045,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)
};
@@ -2230,6 +2237,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 ();
@@ -2402,6 +2419,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;
}
}
}
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 4af139a..d7bd0ab 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -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)
@@ -393,6 +412,109 @@ match_oacc_clause_gang (gfc_omp_clauses *cp)
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)
@@ -453,6 +575,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 +814,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask,
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],
@@ -1176,7 +1304,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 +1421,80 @@ 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;
+ 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;
}
@@ -4613,44 +4809,64 @@ 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;
+ 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)
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index bdb5731..b280621 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1385,7 +1385,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(). */
@@ -2449,7 +2449,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;
@@ -3361,19 +3360,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;
}
@@ -5213,13 +5199,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;
}
diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h
index bcd714d..94b2ada 100644
--- a/gcc/fortran/parse.h
+++ b/gcc/fortran/parse.h
@@ -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;
}
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index bf2837c..7719201 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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;
diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c
index 629b51d..d0a11aa 100644
--- a/gcc/fortran/st.c
+++ b/gcc/fortran/st.c
@@ -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:
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index bd7758b..ff9aff9 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -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,66 @@ 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 +1905,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))
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 7e05e67..0da46ba 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -5759,6 +5759,149 @@ is_ieee_module_used (gfc_namespace *ns)
}
+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
@@ -5895,12 +6038,7 @@ gfc_generate_function_code (gfc_namespace * ns)
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);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index f29f408..261291c 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -4421,13 +4421,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, 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
@@ -4455,6 +4466,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 ();
}
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 1af2ad1..a481eaf 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1575,12 +1575,7 @@ gfc_trans_block_construct (gfc_code* code)
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));
diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h
index 2f2a0b3..0ff93c4 100644
--- a/gcc/fortran/trans-stmt.h
+++ b/gcc/fortran/trans-stmt.h
@@ -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 *);
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index d9ab346..eee9740 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1901,6 +1901,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;
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
index 5cf737f..1ff8e6a 100644
--- a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95
@@ -1,5 +1,4 @@
! { dg-do compile }
-! { dg-additional-options "-fdump-tree-original" }
program test
implicit none
@@ -11,9 +10,7 @@ contains
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" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-2.f95
new file mode 100644
index 0000000..aa1704f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/declare-2.f95
@@ -0,0 +1,71 @@
+
+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
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
new file mode 100644
index 0000000..f717d1b
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90
@@ -0,0 +1,248 @@
+! { 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
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90
new file mode 100644
index 0000000..2aa7907
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90
@@ -0,0 +1,16 @@
+! { 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
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90
new file mode 100644
index 0000000..3a6b420
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90
@@ -0,0 +1,68 @@
+! { 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
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90
new file mode 100644
index 0000000..226264e
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90
@@ -0,0 +1,29 @@
+! { 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
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90
new file mode 100644
index 0000000..bcd9c9c
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90
@@ -0,0 +1,29 @@
+! { 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
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-6.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-6.f90
new file mode 100644
index 0000000..a4ce1e5
--- /dev/null
+++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-6.f90
@@ -0,0 +1,66 @@
+! { dg-do run { target openacc_nvidia_accel_selected } }
+
+module vars
+ implicit none
+ integer :: a(8)
+ !$acc declare device_resident (a)
+
+end module vars
+
+program test
+ use vars
+ implicit none
+ integer, parameter :: N = 8
+ integer :: i, v
+
+ v = 5
+ v = foo (v)
+ if (v .ne. 15) call abort
+ v = foo (v)
+ if (v .ne. 25) call abort
+
+ !$acc parallel copy (v)
+ do i = 1, N
+ a(i) = v * 2
+ end do
+ !$acc end parallel
+
+ !$acc update host (a)
+
+ do i = 1, N
+ if (a(i) .ne. 50) call abort
+ end do
+
+contains
+
+ integer function foo(n)
+ integer, value :: n
+ integer :: i
+ !$acc declare create (i)
+
+ i = 12
+
+ !$acc update device (i)
+
+ i = 13
+
+ BLOCK
+ integer :: i
+ !$acc declare create(i)
+
+ !$acc parallel copy (n)
+ i = n
+ n = 10
+ n = i + n
+ !$acc end parallel
+
+ foo = n
+ END BLOCK
+
+ !$acc update host (i)
+
+ if (i .ne. 12) call abort
+
+ end function foo
+
+end program test
| Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
|---|---|---|
| Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |