diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 1f1d0477406..e1a27462d11 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,48 @@ +2015-11-22 James Norris + Cesar Philippidis + + * 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 * simplify.c (gfc_simplify_cshift): Work around bootstrap issues diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 83ecbaa3d82..48476af56d3 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 e13b4d48afa..5487c9343e4 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 54777f74af3..6b544ee7596 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 4af139a2a17..ffdce0b1848 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; } @@ -2870,7 +3066,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, 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) @@ -4613,45 +4809,65 @@ 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 bdb5731aad1..b2806214e1a 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 bcd714d3bd2..94b2ada8ba7 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 90bc6d49b4b..685e3f54007 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10695,6 +10695,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 629b51d371c..d0a11aab793 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 bd7758b9a45..ff9aff93a14 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) { @@ -1243,6 +1268,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 0e5eecc70e4..39ff8e27f5b 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -5760,6 +5760,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 @@ -5896,12 +6039,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 f29f4088c95..261291c8ef5 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 86548c00731..06591a31a3e 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 2f2a0b3f5b5..0ff93c49033 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 9b44b7109f2..2a91c3521b6 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1917,6 +1917,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/ChangeLog b/gcc/testsuite/ChangeLog index 3c1a9534be7..f3e96187957 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2015-11-22 James Norris + Cesar Philippidis + + * gfortran.dg/goacc/declare-1.f95: Update test. + * gfortran.dg/goacc/declare-2.f95: New test. + 2015-11-22 Bilyan Borisov * gcc.target/aarch64/simd/vmulx_lane_f32_1.c: New. diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 index 5cf737f269b..1ff8e6ab4df 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 00000000000..aa1704f77d0 --- /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/ChangeLog b/libgomp/ChangeLog index 7de19b0a25b..a083f35f762 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,12 @@ +2015-11-22 James Norris + Cesar Philippidis + + * 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 PR middle-end/68221 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 00000000000..f717d1b7626 --- /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 00000000000..2aa79079d91 --- /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 00000000000..3a6b420f1c7 --- /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 00000000000..226264e38c1 --- /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 00000000000..bcd9c9c72b5 --- /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