From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 115006 invoked by alias); 8 Nov 2015 15:29:39 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 114985 invoked by uid 89); 8 Nov 2015 15:29:39 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-2.0 required=5.0 tests=AWL,BAYES_00,RCVD_IN_DNSWL_LOW,SPF_PASS autolearn=ham version=3.3.2 X-HELO: relay1.mentorg.com Received: from relay1.mentorg.com (HELO relay1.mentorg.com) (192.94.38.131) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 08 Nov 2015 15:29:33 +0000 Received: from svr-orw-fem-03.mgc.mentorg.com ([147.34.97.39]) by relay1.mentorg.com with esmtp id 1ZvRuL-00015e-Se from James_Norris@mentor.com ; Sun, 08 Nov 2015 07:29:29 -0800 Received: from [172.30.80.60] (147.34.91.1) by svr-orw-fem-03.mgc.mentorg.com (147.34.97.39) with Microsoft SMTP Server id 14.3.224.2; Sun, 8 Nov 2015 07:29:29 -0800 Message-ID: <563F6A58.2040500@codesourcery.com> Date: Sun, 08 Nov 2015 15:29:00 -0000 From: James Norris User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.7.0 MIME-Version: 1.0 To: James Norris , Jakub Jelinek CC: GCC Patches Subject: Re: OpenACC declare directive updates References: <5637692F.7050306@codesourcery.com> <5639FAC0.2090104@codesourcery.com> <20151106193127.GI5675@tucnak.redhat.com> <563D0345.7010208@codesourcery.com> In-Reply-To: <563D0345.7010208@codesourcery.com> X-TagToolbar-Keys: D20151108092928011 Content-Type: multipart/mixed; boundary="------------010705030507030002070405" X-SW-Source: 2015-11/txt/msg00843.txt.bz2 --------------010705030507030002070405 Content-Type: text/plain; charset="windows-1252"; format=flowed Content-Transfer-Encoding: 7bit Content-length: 554 Jakub, The attached patch and ChangeLog reflect the updates from your review: https://gcc.gnu.org/ml/gcc-patches/2015-11/msg00714.html. All of the issues pointed out, have been address. With the changes made in this patch I think I'm handling the situation that you pointed out here correctly: On Fri, Nov 06, 2015 at 01:45:09PM -0600, James Norris wrote: 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. OK to commit to trunk? Thanks! Jim --------------010705030507030002070405 Content-Type: text/plain; charset="UTF-8"; name="ChangeLog" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="ChangeLog" Content-length: 2642 2015-XX-XX James Norris Cesar Philippidis gcc/fortran/ * dump-parse-tree.c (show_namespace): Handle declares. * f95-lang.c (gfc_attribute_table): New entry. * 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. (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. (gfc_resolve_oacc_declare): Use duplicate detection. * 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_attributes_to_decl): Create identifier. (struct oacc_return): New structure. (find_oacc_return, add_clause, find_module_oacc_declare_clauses, finish_oacc_declare): New functions. (gfc_generate_function_code): Replace with call. * trans-openmp.c (gfc_trans_omp_clauses): Add conditional. (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. gcc/testsuite * gfortran.dg/goacc/declare-1.f95: Update test. * gfortran.dg/goacc/declare-2.f95: New test. libgomp/ * 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. --------------010705030507030002070405 Content-Type: text/x-patch; name="declare.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="declare.patch" Content-length: 42169 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/f95-lang.c b/gcc/fortran/f95-lang.c index 2e91470..a8458b0 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.c @@ -99,6 +99,8 @@ static const struct attribute_spec gfc_attribute_table[] = affects_type_identity } */ { "omp declare target", 0, 0, true, false, false, gfc_handle_omp_declare_target_attribute, false }, + { "oacc declare", 0, 0, true, false, false, + gfc_handle_omp_declare_target_attribute, false }, { NULL, 0, 0, false, false, false, NULL, false } }; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index e13b4d4..3965b08 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,19 @@ gfc_omp_clauses; #define gfc_get_omp_clauses() XCNEW (gfc_omp_clauses) +/* Node in the linked list used for storing !$oacc declare constructs. */ + +typedef struct gfc_oacc_declare +{ + struct gfc_oacc_declare *next; + bool module_var; + gfc_omp_clauses *clauses; +} +gfc_oacc_declare; + +#define gfc_get_oacc_declare() XCNEW (gfc_oacc_declare) + + /* Node in the linked list used for storing !$omp declare simd constructs. */ typedef struct gfc_omp_declare_simd @@ -1645,8 +1668,8 @@ typedef struct gfc_namespace this namespace. */ struct gfc_data *data, *old_data; - /* !$ACC DECLARE clauses. */ - gfc_omp_clauses *oacc_declare_clauses; + /* !$ACC DECLARE. */ + gfc_oacc_declare *oacc_declare; gfc_charlen *cl_list, *old_cl_list; @@ -2324,6 +2347,7 @@ enum gfc_exec_op EXEC_OACC_PARALLEL, EXEC_OACC_KERNELS, EXEC_OACC_DATA, EXEC_OACC_HOST_DATA, EXEC_OACC_LOOP, EXEC_OACC_UPDATE, EXEC_OACC_WAIT, EXEC_OACC_CACHE, EXEC_OACC_ENTER_DATA, EXEC_OACC_EXIT_DATA, EXEC_OACC_ATOMIC, + EXEC_OACC_DECLARE, EXEC_OMP_CRITICAL, EXEC_OMP_DO, EXEC_OMP_FLUSH, EXEC_OMP_MASTER, EXEC_OMP_ORDERED, EXEC_OMP_PARALLEL, EXEC_OMP_PARALLEL_DO, EXEC_OMP_PARALLEL_SECTIONS, EXEC_OMP_PARALLEL_WORKSHARE, @@ -2405,6 +2429,7 @@ typedef struct gfc_code struct gfc_code *which_construct; int stop_code; gfc_entry_list *entry; + gfc_oacc_declare *oacc_declare; gfc_omp_clauses *omp_clauses; const char *omp_name; gfc_omp_namelist *omp_namelist; @@ -2907,6 +2932,7 @@ gfc_expr *gfc_get_parentheses (gfc_expr *); /* openmp.c */ struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; }; void gfc_free_omp_clauses (gfc_omp_clauses *); +void gfc_free_oacc_declare_clauses (struct gfc_oacc_declare *); void gfc_free_omp_declare_simd (gfc_omp_declare_simd *); void gfc_free_omp_declare_simd_list (gfc_omp_declare_simd *); void gfc_free_omp_udr (gfc_omp_udr *); @@ -3224,4 +3250,8 @@ gfc_expr *gfc_simplify_ieee_functions (gfc_expr *); bool gfc_is_reallocatable_lhs (gfc_expr *); +/* trans-decl.c */ + +void finish_oacc_declare (gfc_namespace *, enum sym_flavor); + #endif /* GCC_GFORTRAN_H */ diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 91d2bd6..76fb3bc 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -1987,7 +1987,9 @@ enum ab_attribute AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION, AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER, AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET, - AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE + AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE, + AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR, + AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK }; static const mstring attr_bits[] = @@ -2044,6 +2046,11 @@ static const mstring attr_bits[] = minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET), minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY), minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE), + minit ("OACC_DECLARE_CREATE", AB_OACC_DECLARE_CREATE), + minit ("OACC_DECLARE_COPYIN", AB_OACC_DECLARE_COPYIN), + minit ("OACC_DECLARE_DEVICEPTR", AB_OACC_DECLARE_DEVICEPTR), + minit ("OACC_DECLARE_DEVICE_RESIDENT", AB_OACC_DECLARE_DEVICE_RESIDENT), + minit ("OACC_DECLARE_LINK", AB_OACC_DECLARE_LINK), minit (NULL, -1) }; @@ -2231,6 +2238,16 @@ mio_symbol_attribute (symbol_attribute *attr) MIO_NAME (ab_attribute) (AB_MODULE_PROCEDURE, attr_bits); no_module_procedures = false; } + if (attr->oacc_declare_create) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_CREATE, attr_bits); + if (attr->oacc_declare_copyin) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_COPYIN, attr_bits); + if (attr->oacc_declare_deviceptr) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICEPTR, attr_bits); + if (attr->oacc_declare_device_resident) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_DEVICE_RESIDENT, attr_bits); + if (attr->oacc_declare_link) + MIO_NAME (ab_attribute) (AB_OACC_DECLARE_LINK, attr_bits); mio_rparen (); @@ -2403,6 +2420,21 @@ mio_symbol_attribute (symbol_attribute *attr) case AB_MODULE_PROCEDURE: attr->module_procedure =1; break; + case AB_OACC_DECLARE_CREATE: + attr->oacc_declare_create = 1; + break; + case AB_OACC_DECLARE_COPYIN: + attr->oacc_declare_copyin = 1; + break; + case AB_OACC_DECLARE_DEVICEPTR: + attr->oacc_declare_deviceptr = 1; + break; + case AB_OACC_DECLARE_DEVICE_RESIDENT: + attr->oacc_declare_device_resident = 1; + break; + case AB_OACC_DECLARE_LINK: + attr->oacc_declare_link = 1; + break; } } } diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index a7c7a19..17a62a4 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) @@ -453,6 +472,7 @@ match_oacc_clause_gang (gfc_omp_clauses *cp) #define OMP_CLAUSE_DELETE ((uint64_t) 1 << 55) #define OMP_CLAUSE_AUTO ((uint64_t) 1 << 56) #define OMP_CLAUSE_TILE ((uint64_t) 1 << 57) +#define OMP_CLAUSE_LINK ((uint64_t) 1 << 58) /* Helper function for OpenACC and OpenMP clauses involving memory mapping. */ @@ -691,6 +711,12 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, true) == MATCH_YES) continue; + if ((mask & OMP_CLAUSE_LINK) + && gfc_match_omp_variable_list ("link (", + &c->lists[OMP_LIST_LINK], + true) + == MATCH_YES) + continue; if ((mask & OMP_CLAUSE_OACC_DEVICE) && gfc_match ("device ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -1176,7 +1202,7 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, uint64_t mask, | OMP_CLAUSE_CREATE | OMP_CLAUSE_DEVICEPTR | OMP_CLAUSE_DEVICE_RESIDENT \ | OMP_CLAUSE_PRESENT | OMP_CLAUSE_PRESENT_OR_COPY \ | OMP_CLAUSE_PRESENT_OR_COPYIN | OMP_CLAUSE_PRESENT_OR_COPYOUT \ - | OMP_CLAUSE_PRESENT_OR_CREATE) + | OMP_CLAUSE_PRESENT_OR_CREATE | OMP_CLAUSE_LINK) #define OACC_UPDATE_CLAUSES \ (OMP_CLAUSE_IF | OMP_CLAUSE_ASYNC | OMP_CLAUSE_HOST_SELF \ | OMP_CLAUSE_OACC_DEVICE | OMP_CLAUSE_WAIT) @@ -1293,12 +1319,86 @@ match gfc_match_oacc_declare (void) { gfc_omp_clauses *c; + gfc_omp_namelist *n; + gfc_namespace *ns = gfc_current_ns; + gfc_oacc_declare *new_oc; + bool module_var = false; + if (gfc_match_omp_clauses (&c, OACC_DECLARE_CLAUSES, false, false, true) != MATCH_YES) return MATCH_ERROR; - new_st.ext.omp_clauses = c; - new_st.ext.omp_clauses->loc = gfc_current_locus; + for (n = c->lists[OMP_LIST_DEVICE_RESIDENT]; n != NULL; n = n->next) + n->sym->attr.oacc_declare_device_resident = 1; + + for (n = c->lists[OMP_LIST_LINK]; n != NULL; n = n->next) + n->sym->attr.oacc_declare_link = 1; + + for (n = c->lists[OMP_LIST_MAP]; n != NULL; n = n->next) + { + gfc_symbol *s = n->sym; + locus where = gfc_current_locus; + + if (s->ns->proc_name && s->ns->proc_name->attr.proc == PROC_MODULE) + { + if (n->u.map_op != OMP_MAP_FORCE_ALLOC + && n->u.map_op != OMP_MAP_FORCE_TO) + { + gfc_error ("Invalid clause in module with $!ACC DECLARE at %L", + &where); + return MATCH_ERROR; + } + + module_var = true; + } + + if (s->attr.in_common) + { + gfc_error ("Variable in a common block with $!ACC DECLARE at %L", + &where); + return MATCH_ERROR; + } + + if (s->attr.use_assoc) + { + gfc_error ("Variable is USE-associated with $!ACC DECLARE at %L", + &where); + return MATCH_ERROR; + } + + if ((s->attr.dimension || s->attr.codimension) + && s->attr.dummy && s->as->type != AS_EXPLICIT) + { + gfc_error ("Assumed-size dummy array with $!ACC DECLARE at %L", + &where); + return MATCH_ERROR; + } + + switch (n->u.map_op) + { + case OMP_MAP_FORCE_ALLOC: + s->attr.oacc_declare_create = 1; + break; + + case OMP_MAP_FORCE_TO: + s->attr.oacc_declare_copyin = 1; + break; + + case OMP_MAP_FORCE_DEVICEPTR: + s->attr.oacc_declare_deviceptr = 1; + break; + + default: + break; + } + } + + new_oc = gfc_get_oacc_declare (); + new_oc->next = ns->oacc_declare; + new_oc->module_var = module_var; + new_oc->clauses = c; + ns->oacc_declare = new_oc; + return MATCH_YES; } @@ -4613,44 +4713,80 @@ resolve_oacc_loop (gfc_code *code) resolve_oacc_nested_loops (code, do_code, collapse, "collapsed"); } - void gfc_resolve_oacc_declare (gfc_namespace *ns) { int list; gfc_omp_namelist *n; locus loc; + gfc_oacc_declare *oc; - if (ns->oacc_declare_clauses == NULL) + if (ns->oacc_declare == NULL) return; - loc = ns->oacc_declare_clauses->loc; + loc = gfc_current_locus; - for (list = OMP_LIST_DEVICE_RESIDENT; - list <= OMP_LIST_DEVICE_RESIDENT; list++) - for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next) - { - n->sym->mark = 0; - if (n->sym->attr.flavor == FL_PARAMETER) - gfc_error ("PARAMETER object %qs is not allowed at %L", n->sym->name, &loc); - } + for (oc = ns->oacc_declare; oc; oc = oc->next) + { + for (list = OMP_LIST_DEVICE_RESIDENT; + list <= OMP_LIST_DEVICE_RESIDENT; list++) + for (n = oc->clauses->lists[list]; n; n = n->next) + { + n->sym->mark = 0; + if (n->sym->attr.flavor == FL_PARAMETER) + gfc_error ("PARAMETER object %qs is not allowed at %L", + n->sym->name, &loc); + } - for (list = OMP_LIST_DEVICE_RESIDENT; - list <= OMP_LIST_DEVICE_RESIDENT; list++) - for (n = ns->oacc_declare_clauses->lists[list]; n; n = n->next) - { - if (n->sym->mark) - gfc_error ("Symbol %qs present on multiple clauses at %L", - n->sym->name, &loc); - else - n->sym->mark = 1; - } + for (list = OMP_LIST_DEVICE_RESIDENT; + list <= OMP_LIST_DEVICE_RESIDENT; list++) + for (n = oc->clauses->lists[list]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &loc); + else + n->sym->mark = 1; + } - for (n = ns->oacc_declare_clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n; - n = n->next) - check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT"); -} + for (n = oc->clauses->lists[OMP_LIST_DEVICE_RESIDENT]; n; n = n->next) + check_array_not_assumed (n->sym, loc, "DEVICE_RESIDENT"); + + for (n = oc->clauses->lists[OMP_LIST_MAP]; n; n = n->next) + { + if (n->expr && n->expr->ref->type == REF_ARRAY) + gfc_error ("Array sections: %qs not allowed in" + " $!ACC DECLARE at %L", n->sym->name, &loc); + } + } + + for (oc = ns->oacc_declare; oc; oc = oc->next) + { + for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++) + for (n = oc->clauses->lists[list]; n; n = n->next) + n->sym->mark = 0; + } + for (oc = ns->oacc_declare; oc; oc = oc->next) + { + for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++) + for (n = oc->clauses->lists[list]; n; n = n->next) + { + if (n->sym->mark) + gfc_error ("Symbol %qs present on multiple clauses at %L", + n->sym->name, &loc); + else + n->sym->mark = 1; + } + } + + for (oc = ns->oacc_declare; oc; oc = oc->next) + { + for (list = OMP_LIST_LINK; list <= OMP_LIST_LINK; list++) + for (n = oc->clauses->lists[list]; n; n = n->next) + n->sym->mark = 0; + } +} void gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index b98dda1..b1c5034 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1386,7 +1386,7 @@ next_statement (void) case ST_EQUIVALENCE: case ST_NAMELIST: case ST_STATEMENT_FUNCTION: \ case ST_TYPE: case ST_INTERFACE: case ST_OMP_THREADPRIVATE: \ case ST_PROCEDURE: case ST_OMP_DECLARE_SIMD: case ST_OMP_DECLARE_REDUCTION: \ - case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE + case ST_OMP_DECLARE_TARGET: case ST_OACC_ROUTINE: case ST_OACC_DECLARE /* Block end statements. Errors associated with interchanging these are detected in gfc_match_end(). */ @@ -2450,7 +2450,6 @@ verify_st_order (st_state *p, gfc_statement st, bool silent) case ST_PUBLIC: case ST_PRIVATE: case ST_DERIVED_DECL: - case ST_OACC_DECLARE: case_decl: if (p->state >= ORDER_EXEC) goto order; @@ -3362,19 +3361,6 @@ declSt: st = next_statement (); goto loop; - case ST_OACC_DECLARE: - if (!verify_st_order(&ss, st, false)) - { - reject_statement (); - st = next_statement (); - goto loop; - } - if (gfc_state_stack->ext.oacc_declare_clauses == NULL) - gfc_state_stack->ext.oacc_declare_clauses = new_st.ext.omp_clauses; - accept_statement (st); - st = next_statement (); - goto loop; - default: break; } @@ -5214,13 +5200,6 @@ contains: done: gfc_current_ns->code = gfc_state_stack->head; - if (gfc_state_stack->state == COMP_PROGRAM - || gfc_state_stack->state == COMP_MODULE - || gfc_state_stack->state == COMP_SUBROUTINE - || gfc_state_stack->state == COMP_FUNCTION - || gfc_state_stack->state == COMP_BLOCK) - gfc_current_ns->oacc_declare_clauses - = gfc_state_stack->ext.oacc_declare_clauses; } 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..43fd25d 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,62 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name, bool +gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name, locus *where) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->oacc_declare_create) + return true; + + attr->oacc_declare_create = 1; + return check_conflict (attr, name, where); +} + + +bool +gfc_add_oacc_declare_copyin (symbol_attribute *attr, const char *name, locus *where) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->oacc_declare_copyin) + return true; + + attr->oacc_declare_copyin = 1; + return check_conflict (attr, name, where); +} + + +bool +gfc_add_oacc_declare_deviceptr (symbol_attribute *attr, const char *name, locus *where) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->oacc_declare_deviceptr) + return true; + + attr->oacc_declare_deviceptr = 1; + return check_conflict (attr, name, where); +} + + +bool +gfc_add_oacc_declare_device_resident (symbol_attribute *attr, const char *name, locus *where) +{ + if (check_used (attr, name, where)) + return false; + + if (attr->oacc_declare_device_resident) + return true; + + attr->oacc_declare_device_resident = 1; + return check_conflict (attr, name, where); +} + + +bool gfc_add_target (symbol_attribute *attr, locus *where) { @@ -1820,6 +1901,18 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where) if (src->omp_declare_target && !gfc_add_omp_declare_target (dest, NULL, where)) goto fail; + if (src->oacc_declare_create + && !gfc_add_oacc_declare_create (dest, NULL, where)) + goto fail; + if (src->oacc_declare_copyin + && !gfc_add_oacc_declare_copyin (dest, NULL, where)) + goto fail; + if (src->oacc_declare_deviceptr + && !gfc_add_oacc_declare_deviceptr (dest, NULL, where)) + goto fail; + if (src->oacc_declare_device_resident + && !gfc_add_oacc_declare_device_resident (dest, NULL, where)) + goto fail; if (src->target && !gfc_add_target (dest, where)) goto fail; if (src->dummy && !gfc_add_dummy (dest, NULL, where)) diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 098a327..545d80f 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1307,6 +1307,15 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list) list = tree_cons (get_identifier ("omp declare target"), NULL_TREE, list); + if (sym_attr.oacc_declare_create + || sym_attr.oacc_declare_copyin + || sym_attr.oacc_declare_deviceptr + || sym_attr.oacc_declare_device_resident + || sym_attr.oacc_declare_link) + { + list = tree_cons (get_identifier ("oacc declare"), + NULL_TREE, list); + } return list; } @@ -5761,6 +5770,258 @@ is_ieee_module_used (gfc_namespace *ns) return seen_ieee_symbol; } +static struct oacc_return +{ + gfc_code *code; + struct oacc_return *next; +} *oacc_returns; + +static void +find_oacc_return (gfc_code *code) +{ + if (code->next) + { + if (code->next->op == EXEC_RETURN + || code->next->op == EXEC_END_PROCEDURE) + { + struct oacc_return *r; + + r = XCNEW (struct oacc_return); + r->code = code; + r->next = NULL; + + if (oacc_returns) + r->next = oacc_returns; + + oacc_returns = r; + } + else + { + find_oacc_return (code->next); + } + } + else if (code->block) + find_oacc_return (code->block); + else + { + struct oacc_return *r; + + r = XCNEW (struct oacc_return); + r->code = code; + r->next = NULL; + + if (oacc_returns) + r->next = oacc_returns; + + oacc_returns = r; + } + + return; +} + +static gfc_omp_clauses *module_oacc_clauses; + +static void +add_clause (gfc_symbol *sym, gfc_omp_map_op map_op) +{ + gfc_omp_namelist *n; + + n = gfc_get_omp_namelist (); + n->sym = sym; + n->u.map_op = map_op; + + if (!module_oacc_clauses) + module_oacc_clauses = gfc_get_omp_clauses (); + + if (module_oacc_clauses->lists[OMP_LIST_MAP]) + n->next = module_oacc_clauses->lists[OMP_LIST_MAP]; + + module_oacc_clauses->lists[OMP_LIST_MAP] = n; +} + + +static void +find_module_oacc_declare_clauses (gfc_symbol *sym) +{ + if (sym->attr.use_assoc) + { + gfc_omp_map_op map_op; + + if (sym->attr.oacc_declare_create) + map_op = OMP_MAP_FORCE_ALLOC; + + if (sym->attr.oacc_declare_copyin) + map_op = OMP_MAP_FORCE_TO; + + if (sym->attr.oacc_declare_deviceptr) + map_op = OMP_MAP_FORCE_DEVICEPTR; + + if (sym->attr.oacc_declare_device_resident) + map_op = OMP_MAP_DEVICE_RESIDENT; + + if (sym->attr.oacc_declare_create + || sym->attr.oacc_declare_copyin + || sym->attr.oacc_declare_deviceptr + || sym->attr.oacc_declare_device_resident) + { + sym->attr.referenced = 1; + add_clause (sym, map_op); + } + } +} + +void +finish_oacc_declare (gfc_namespace *ns, enum sym_flavor flavor) +{ + gfc_code *code; + gfc_oacc_declare *oc; + gfc_omp_namelist *n; + locus where = gfc_current_locus; + gfc_omp_clauses *ret_clauses = NULL; + + gfc_traverse_ns (ns, find_module_oacc_declare_clauses); + + if (module_oacc_clauses && flavor == FL_PROGRAM) + { + gfc_oacc_declare *new_oc; + + new_oc = gfc_get_oacc_declare (); + new_oc->next = ns->oacc_declare; + new_oc->clauses = module_oacc_clauses; + + ns->oacc_declare = new_oc; + module_oacc_clauses = NULL; + } + + if (!ns->oacc_declare) + return; + + for (oc = ns->oacc_declare; oc; oc = oc->next) + { + gfc_omp_clauses *omp_clauses; + + if (oc->module_var) + continue; + + if (oc->clauses) + { + code = XCNEW (gfc_code); + code->op = EXEC_OACC_DECLARE; + code->loc = where; + + omp_clauses = oc->clauses; + + for (n = omp_clauses->lists[OMP_LIST_MAP]; n; n = n->next) + { + bool ret = false; + gfc_omp_map_op new_op; + + switch (n->u.map_op) + { + case OMP_MAP_ALLOC: + case OMP_MAP_FORCE_ALLOC: + new_op = OMP_MAP_FORCE_DEALLOC; + ret = true; + break; + + case OMP_MAP_DEVICE_RESIDENT: + n->u.map_op = OMP_MAP_FORCE_ALLOC; + new_op = OMP_MAP_FORCE_DEALLOC; + ret = true; + break; + + case OMP_MAP_FORCE_FROM: + n->u.map_op = OMP_MAP_FORCE_ALLOC; + new_op = OMP_MAP_FORCE_FROM; + ret = true; + break; + + case OMP_MAP_FORCE_TO: + new_op = OMP_MAP_FORCE_DEALLOC; + ret = true; + break; + + case OMP_MAP_FORCE_TOFROM: + n->u.map_op = OMP_MAP_FORCE_TO; + new_op = OMP_MAP_FORCE_FROM; + ret = true; + break; + + case OMP_MAP_FROM: + n->u.map_op = OMP_MAP_FORCE_ALLOC; + new_op = OMP_MAP_FROM; + ret = true; + break; + + case OMP_MAP_FORCE_DEVICEPTR: + case OMP_MAP_FORCE_PRESENT: + case OMP_MAP_LINK: + case OMP_MAP_TO: + break; + + case OMP_MAP_TOFROM: + n->u.map_op = OMP_MAP_TO; + new_op = OMP_MAP_FROM; + ret = true; + break; + + default: + gcc_unreachable (); + break; + } + + if (ret) + { + gfc_omp_namelist *new_n; + + new_n = gfc_get_omp_namelist (); + new_n->sym = n->sym; + new_n->u.map_op = new_op; + + if (!ret_clauses) + ret_clauses = gfc_get_omp_clauses (); + + if (ret_clauses->lists[OMP_LIST_MAP]) + new_n->next = ret_clauses->lists[OMP_LIST_MAP]; + + ret_clauses->lists[OMP_LIST_MAP] = new_n; + ret = false; + } + } + + code->ext.oacc_declare = gfc_get_oacc_declare (); + code->ext.oacc_declare->clauses = omp_clauses; + + if (ns->code) + code->next = ns->code; + ns->code = code; + } + } + + find_oacc_return (ns->code); + + while (oacc_returns) + { + struct oacc_return *r; + + r = oacc_returns; + + code = XCNEW (gfc_code); + code->op = EXEC_OACC_DECLARE; + code->loc = where; + + code->ext.oacc_declare = gfc_get_oacc_declare (); + code->ext.oacc_declare->clauses = ret_clauses; + code->next = r->code->next; + r->code->next = code; + + oacc_returns = r->next; + free (r); + } + + return; +} + /* Generate code for a function. */ @@ -5899,11 +6160,7 @@ gfc_generate_function_code (gfc_namespace * ns) add_argument_checking (&body, sym); /* Generate !$ACC DECLARE directive. */ - if (ns->oacc_declare_clauses) - { - tree tmp = gfc_trans_oacc_declare (&body, ns); - gfc_add_expr_to_block (&body, tmp); - } + finish_oacc_declare (ns, sym->attr.flavor); tmp = gfc_trans_code (ns->code); gfc_add_expr_to_block (&body, tmp); diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c index 9f0d533..57d63ae 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.c @@ -1925,6 +1925,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (!n->sym->attr.referenced) continue; + if (n->sym->attr.use_assoc && n->sym->attr.oacc_declare_link) + continue; + tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP); tree node2 = NULL_TREE; tree node3 = NULL_TREE; @@ -4423,13 +4426,24 @@ gfc_trans_omp_workshare (gfc_code *code, gfc_omp_clauses *clauses) } tree -gfc_trans_oacc_declare (stmtblock_t *block, gfc_namespace *ns) +gfc_trans_oacc_declare (gfc_code *code) { - tree oacc_clauses; - oacc_clauses = gfc_trans_omp_clauses (block, ns->oacc_declare_clauses, - ns->oacc_declare_clauses->loc); - return build1_loc (ns->oacc_declare_clauses->loc.lb->location, - OACC_DECLARE, void_type_node, oacc_clauses); + stmtblock_t block; + tree stmt, c; + enum tree_code construct_code; + + gfc_start_block (&block); + + construct_code = OACC_DECLARE; + + gfc_start_block (&block); + c = gfc_trans_omp_clauses (&block, code->ext.oacc_declare->clauses, + code->loc); + + stmt = build1_loc (input_location, construct_code, void_type_node, c); + gfc_add_expr_to_block (&block, stmt); + + return gfc_finish_block (&block); } tree @@ -4457,6 +4471,8 @@ gfc_trans_oacc_directive (gfc_code *code) return gfc_trans_oacc_wait_directive (code); case EXEC_OACC_ATOMIC: return gfc_trans_omp_atomic (code); + case EXEC_OACC_DECLARE: + return gfc_trans_oacc_declare (code); default: gcc_unreachable (); } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 1c61606..321cd80 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1579,11 +1579,7 @@ gfc_trans_block_construct (gfc_code* code) code->exit_label = exit_label; /* Generate !$ACC DECLARE directive. */ - if (ns->oacc_declare_clauses) - { - tree tmp = gfc_trans_oacc_declare (&body, ns); - gfc_add_expr_to_block (&body, tmp); - } + finish_oacc_declare (ns, FL_UNKNOWN); gfc_add_expr_to_block (&body, gfc_trans_code (ns->code)); gfc_add_expr_to_block (&body, build1_v (LABEL_EXPR, exit_label)); 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 9495450..880c309 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -1904,6 +1904,7 @@ trans_code (gfc_code * code, tree cond) case EXEC_OACC_ENTER_DATA: case EXEC_OACC_EXIT_DATA: case EXEC_OACC_ATOMIC: + case EXEC_OACC_DECLARE: res = gfc_trans_oacc_directive (code); break; diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 index 5cf737f..3129f04 100644 --- a/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/declare-1.f95 @@ -15,5 +15,4 @@ contains END BLOCK end function foo end program test -! { dg-prune-output "unimplemented" } -! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_tofrom:i\\)" 2 "original" } } +! { dg-final { scan-tree-dump-times "pragma acc declare map\\(force_to:i\\)" 2 "original" } } diff --git a/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 b/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 index e69de29..9450c8b 100644 --- a/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 +++ b/gcc/testsuite/gfortran.dg/goacc/declare-2.f95 @@ -0,0 +1,44 @@ + +module amod + +contains + +subroutine asubr (b) + implicit none + integer :: b(8) + + !$acc declare copy (b) ! { dg-error "Invalid clause in module" } + !$acc declare copyout (b) ! { dg-error "Invalid clause in module" } + !$acc declare present (b) ! { dg-error "Invalid clause in module" } + !$acc declare present_or_copy (b) ! { dg-error "Invalid clause in module" } + !$acc declare present_or_copyin (b) ! { dg-error "Invalid clause in module" } + !$acc declare present_or_copyout (b) ! { dg-error "Invalid clause in module" } + !$acc declare present_or_create (b) ! { dg-error "Invalid clause in module" } + !$acc declare deviceptr (b) ! { dg-error "Invalid clause in module" } + !$acc declare create (b) copyin (b) ! { dg-error "present on multiple clauses" } + +end subroutine + +end module + +subroutine bsubr (foo) + implicit none + + integer, dimension (:) :: foo + + !$acc declare copy (foo) ! { dg-error "assumed-size dummy array" } + !$acc declare copy (foo(1:2)) ! { dg-error "assumed-size dummy array" } + +end subroutine + +program test + integer :: a(8) + integer :: b(8) + integer :: c(8) + + !$acc declare create (a) copyin (a) ! { dg-error "present on multiple clauses" } + !$acc declare copyin (b) + !$acc declare copyin (b) ! { dg-error "present on multiple clauses" } + !$acc declare copy (c(1:2)) ! { dg-error "Array sections: 'c' not allowed" } + +end program diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 index e69de29..18dd1bb 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-1.f90 @@ -0,0 +1,236 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module vars + integer z + !$acc declare create (z) +end module vars + +subroutine subr6 (a, d) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare deviceptr (a) + integer :: d(N) + + i = 0 + + !$acc parallel copy (d) + do i = 1, N + d(i) = a(i) + a(i) + end do + !$acc end parallel + +end subroutine + +subroutine subr5 (a, b, c, d) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present_or_copyin (a) + integer :: b(N) + !$acc declare present_or_create (b) + integer :: c(N) + !$acc declare present_or_copyout (c) + integer :: d(N) + !$acc declare present_or_copy (d) + + i = 0 + + !$acc parallel + do i = 1, N + b(i) = a(i) + c(i) = b(i) + d(i) = d(i) + b(i) + end do + !$acc end parallel + +end subroutine + +subroutine subr4 (a, b) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present (a) + integer :: b(N) + !$acc declare copyout (b) + + i = 0 + + !$acc parallel + do i = 1, N + b(i) = a(i) + end do + !$acc end parallel + +end subroutine + +subroutine subr3 (a, c) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present (a) + integer :: c(N) + !$acc declare copyin (c) + + i = 0 + + !$acc parallel + do i = 1, N + a(i) = c(i) + c(i) = 0 + end do + !$acc end parallel + +end subroutine + +subroutine subr2 (a, b, c) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present (a) + integer :: b(N) + !$acc declare create (b) + integer :: c(N) + !$acc declare copy (c) + + i = 0 + + !$acc parallel + do i = 1, N + b(i) = a(i) + c(i) = b(i) + c(i) + 1 + end do + !$acc end parallel + +end subroutine + +subroutine subr1 (a) + integer, parameter :: N = 8 + integer :: i + integer :: a(N) + !$acc declare present (a) + + i = 0 + + !$acc parallel + do i = 1, N + a(i) = a(i) + 1 + end do + !$acc end parallel + +end subroutine + +subroutine test (a, e) + use openacc + logical :: e + integer, parameter :: N = 8 + integer :: a(N) + + if (acc_is_present (a) .neqv. e) call abort + +end subroutine + +subroutine subr0 (a, b, c, d) + integer, parameter :: N = 8 + integer :: a(N) + !$acc declare copy (a) + integer :: b(N) + integer :: c(N) + integer :: d(N) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + call subr1 (a) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + call subr2 (a, b, c) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + do i = 1, N + if (c(i) .ne. 8) call abort + end do + + call subr3 (a, c) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + do i = 1, N + if (a(i) .ne. 2) call abort + if (c(i) .ne. 8) call abort + end do + + call subr4 (a, b) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + + do i = 1, N + if (b(i) .ne. 8) call abort + end do + + call subr5 (a, b, c, d) + + call test (a, .true.) + call test (b, .false.) + call test (c, .false.) + call test (d, .false.) + + do i = 1, N + if (c(i) .ne. 8) call abort + if (d(i) .ne. 13) call abort + end do + + call subr6 (a, d) + + call test (a, .true.) + call test (d, .false.) + + do i = 1, N + if (d(i) .ne. 16) call abort + end do + +end subroutine + +program main + use vars + use openacc + integer, parameter :: N = 8 + integer :: a(N) + integer :: b(N) + integer :: c(N) + integer :: d(N) + + a(:) = 2 + b(:) = 3 + c(:) = 4 + d(:) = 5 + + if (acc_is_present (z) .neqv. .true.) call abort + + call subr0 (a, b, c, d) + + call test (a, .false.) + call test (b, .false.) + call test (c, .false.) + call test (d, .false.) + + do i = 1, N + if (a(i) .ne. 8) call abort + if (b(i) .ne. 8) call abort + if (c(i) .ne. 8) call abort + if (d(i) .ne. 16) call abort + end do + + +end program diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 index e69de29..9b75aa1 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-2.f90 @@ -0,0 +1,14 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module globalvars + integer a + !$acc declare create (a) +end module globalvars + +program test + use globalvars + use openacc + + if (acc_is_present (a) .neqv. .true.) call abort + +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 index e69de29..79fc011 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-3.f90 @@ -0,0 +1,65 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module globalvars + real b + !$acc declare link (b) +end module globalvars + +program test + use openacc + + real a + real c + !$acc declare link (c) + + if (acc_is_present (b) .neqv. .false.) call abort + if (acc_is_present (c) .neqv. .false.) call abort + + a = 0.0 + b = 1.0 + + !$acc parallel copy (a) copyin (b) + b = b + 4.0 + a = b + !$acc end parallel + + if (a .ne. 5.0) call abort + + if (acc_is_present (b) .neqv. .false.) call abort + + a = 0.0 + + !$acc parallel copy (a) create (b) + b = 4.0 + a = b + !$acc end parallel + + if (a .ne. 4.0) call abort + + if (acc_is_present (b) .neqv. .false.) call abort + + a = 0.0 + + !$acc parallel copy (a) copy (b) + b = 4.0 + a = b + !$acc end parallel + + if (a .ne. 4.0) call abort + if (b .ne. 4.0) call abort + + if (acc_is_present (b) .neqv. .false.) call abort + + a = 0.0 + + !$acc parallel copy (a) copy (b) copy (c) + b = 4.0 + c = b + a = c + !$acc end parallel + + if (a .ne. 4.0) call abort + + if (acc_is_present (b) .neqv. .false.) call abort + +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 index e69de29..997c8ac 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-4.f90 @@ -0,0 +1,27 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module vars + real b + !$acc declare create (b) +end module vars + +program test + use vars + use openacc + real a + + if (acc_is_present (b) .neqv. .true.) call abort + + a = 2.0 + + !$acc parallel copy (a) + b = a + a = 1.0 + a = a + b + !$acc end parallel + + if (acc_is_present (b) .neqv. .true.) call abort + + if (a .ne. 3.0) call abort + +end program test diff --git a/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 index e69de29..d7c9bac 100644 --- a/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 +++ b/libgomp/testsuite/libgomp.oacc-fortran/declare-5.f90 @@ -0,0 +1,28 @@ +! { dg-do run { target openacc_nvidia_accel_selected } } + +module vars + implicit none + real b + !$acc declare device_resident (b) +end module vars + +program test + use vars + use openacc + real a + + if (acc_is_present (b) .neqv. .true.) call abort + + a = 2.0 + + !$acc parallel copy (a) + b = a + a = 1.0 + a = a + b + !$acc end parallel + + if (acc_is_present (b) .neqv. .true.) call abort + + if (a .ne. 3.0) call abort + +end program test --------------010705030507030002070405--