From patchwork Fri Jul 11 10:11:10 2014 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Thomas Schwinge X-Patchwork-Id: 369101 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 83E241400B9 for ; Fri, 11 Jul 2014 20:11:39 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:in-reply-to:references:date:message-id :mime-version:content-type; q=dns; s=default; b=a0GH4EwcveWE6pMu 6Wwm20jcHZGb95+3E945QyOGjBzzbeQcLiu0P621Mu0u0+OBfBzWis59hS0ul6wO Kxh1ipPPbrTOxAiwJSElcq5lZxH8sqoqeSEbr7DTonD2O/B0bJ3CUz2+2ZIikFsz ZPBxn9HYcDV21BQJSkTXhfGRLeM= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:from :to:cc:subject:in-reply-to:references:date:message-id :mime-version:content-type; s=default; bh=VC3YH+L+T9TAqlmkWS3XPB Cj29U=; b=vlMFNfWYWTyOZ1NyTnxcaW+elk7kadkyz14Y1JLuuDiqMOMbkxM/30 7PQQW5v5UpnM8aF6CAiLLtKm7y0zXOAwbqR3DjKBuNIAd5RxPL6CIeH/nY+9TgSv /jH/tIZM2Y3ERBkXC6MgG0XFlxIyxH/Ar7lFgiQW1YVxzqProALiU= Received: (qmail 11498 invoked by alias); 11 Jul 2014 10:11:31 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 11361 invoked by uid 89); 11 Jul 2014 10:11:30 -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 autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients 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; Fri, 11 Jul 2014 10:11:24 +0000 Received: from svr-orw-fem-01.mgc.mentorg.com ([147.34.98.93]) by relay1.mentorg.com with esmtp id 1X5XnS-0003ma-Qm from Thomas_Schwinge@mentor.com ; Fri, 11 Jul 2014 03:11:18 -0700 Received: from SVR-IES-FEM-01.mgc.mentorg.com ([137.202.0.104]) by svr-orw-fem-01.mgc.mentorg.com over TLS secured channel with Microsoft SMTPSVC(6.0.3790.4675); Fri, 11 Jul 2014 03:11:16 -0700 Received: from feldtkeller.schwinge.homeip.net (137.202.0.76) by SVR-IES-FEM-01.mgc.mentorg.com (137.202.0.104) with Microsoft SMTP Server id 14.2.247.3; Fri, 11 Jul 2014 11:11:14 +0100 From: Thomas Schwinge To: , Cesar Philippidis , , CC: Ilmir Usmanov , Ilmir Usmanov Subject: Re: FWD: Re: OpenACC subarray specifications in the GCC Fortran front end In-Reply-To: <537DA7CD.4050407@samsung.com> References: <87ha4p92qj.fsf@schwinge.name> <53763254.1000402@samsung.com> <537DA7CD.4050407@samsung.com> User-Agent: Notmuch/0.9-101-g81dad07 (http://notmuchmail.org) Emacs/24.3.1 (x86_64-pc-linux-gnu) Date: Fri, 11 Jul 2014 12:11:10 +0200 Message-ID: <87fvi8p5mp.fsf@schwinge.name> MIME-Version: 1.0 Hi! On Thu, 22 May 2014 11:31:25 +0400, Ilmir Usmanov wrote: > On 16.05.2014 19:44, Ilmir Usmanov wrote: > > On 16.05.2014 19:12, Thomas Schwinge wrote: > >> You recently indicated that you have already begun implementing OpenACC > >> subarray specifications in the GCC Fortran front end, but have not > >> been/are not currently able to complete that. Would you be willing to > >> share your WIP patch with Cesar, who is now working on this, so that he > >> doesn't have to duplicate your work? > > Sure! I'm glad to know that my work won't go directly to trash. :-) > > You can find the patch in attachment. > > > > I started to implement sub-arrays in gfortran by implementing OpenMP > > 4.0 target map clause. This clause was already implemented in C/C++ > > FEs, so I could check the behavior. I don't know whether it's already > > implemented in gfortran or not. To avoid duplication of work: with Jakub's Fortran OpenMP 4 target changes recently committed to trunk, and now merged into gomp-4_0-branch, I have trimmed down Ilmir's patch to just the OpenACC bits, OpenMP 4 target changes removed, and TODO markers added to integrate into that. Jakub, before your Fortran OpenMP 4 target changes, Ilmir had written the test case gcc/testsuite/gfortran.dg/gomp/map-1.f90 (based on his interpretation and implementation of OpenMP 4 target), which I have now amended with XFAILs and changed error messages -- anything in there that you'd like to see addressed for Fortran OpenMP 4 target? > > To represent OpenMP array sections (or OpenACC subarrays) I used > > gfc_expr. > > > > After implementing OpenMP target map clauses I was going to use it to > > represent OpenACC data clauses, just as Thomas recommended in his > > mail: http://gcc.gnu.org/ml/gcc-patches/2014-01/msg02040.html > > > > I hope this will be useful for you. If you will have any question feel > > free to ask. gcc/fortran/dump-parse-tree.c | 47 +++++-- gcc/fortran/gfortran.h | 18 +++ gcc/fortran/openmp.c | 182 ++++++++++++++++++++++++++ gcc/fortran/trans-openmp.c | 145 +++++++++++++++++++- gcc/testsuite/gfortran.dg/goacc/subarrays.f95 | 36 +++++ gcc/testsuite/gfortran.dg/gomp/map-1.f90 | 109 +++++++++++++++ 6 files changed, 520 insertions(+), 17 deletions(-) Grüße, Thomas diff --git gcc/fortran/dump-parse-tree.c gcc/fortran/dump-parse-tree.c index c3671395..8d7c38c 100644 --- gcc/fortran/dump-parse-tree.c +++ gcc/fortran/dump-parse-tree.c @@ -1072,6 +1072,18 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n) } } +/* TODO: remove; use show_omp_namelist. */ +static void +show_expr_list (gfc_expr_list *el) +{ + for (; el->next; el = el->next) + { + show_expr (el->expr); + fputc (',', dumpfile); + } + show_expr (el->expr); +} + /* Show OpenMP or OpenACC clauses. */ @@ -1214,28 +1226,35 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fprintf (dumpfile, " DEFAULT(%s)", type); } + for (int kind = 0; kind < OMP_MAP_LIST_LAST; kind++) + { + const char *type; + if (omp_clauses->map_lists[kind] == NULL) + continue; + + switch (kind) + { + case OMP_MAP_LIST_ALLOC: type = "ALLOC"; break; + case OMP_MAP_LIST_TO: type = "TO"; break; + case OMP_MAP_LIST_FROM: type = "FROM"; break; + case OMP_MAP_LIST_TOFROM: type = "TOFROM"; break; + default: + gcc_unreachable (); + } + fprintf (dumpfile, " MAP(%s:", type); + show_expr_list (omp_clauses->map_lists[kind]); + fputc (')', dumpfile); + } if (omp_clauses->tile_list) { - gfc_expr_list *list; fputs (" TILE(", dumpfile); - for (list = omp_clauses->tile_list; list; list = list->next) - { - show_expr (list->expr); - if (list->next) - fputs (", ", dumpfile); - } + show_expr_list (omp_clauses->tile_list); fputc (')', dumpfile); } if (omp_clauses->wait_list) { - gfc_expr_list *list; fputs (" WAIT(", dumpfile); - for (list = omp_clauses->wait_list; list; list = list->next) - { - show_expr (list->expr); - if (list->next) - fputs (", ", dumpfile); - } + show_expr_list (omp_clauses->wait_list); fputc (')', dumpfile); } if (omp_clauses->seq) diff --git gcc/fortran/gfortran.h gcc/fortran/gfortran.h index cc445e6..09da2d1 100644 --- gcc/fortran/gfortran.h +++ gcc/fortran/gfortran.h @@ -1172,6 +1172,22 @@ enum OMP_LIST_NUM }; +/* OpenACC 2.0: data clauses kind. */ +/* TODO: remove; use OpenMP 4 target infrastructure. */ +enum gfc_omp_clause_map_kind +{ + /* If not already present, allocate. */ + OMP_MAP_LIST_ALLOC, + /* ..., and copy to device. */ + OMP_MAP_LIST_TO, + /* ..., and copy from device. */ + OMP_MAP_LIST_FROM, + /* ..., and copy to and from device. */ + OMP_MAP_LIST_TOFROM, + /* End marker. */ + OMP_MAP_LIST_LAST +}; + /* Because a symbol can belong to multiple namelists, they must be linked externally to the symbol itself. */ @@ -1217,6 +1233,8 @@ typedef struct gfc_omp_clauses struct gfc_expr *final_expr; struct gfc_expr *num_threads; gfc_omp_namelist *lists[OMP_LIST_NUM]; + /* TODO: remove; use OpenMP 4 target infrastructure. */ + gfc_expr_list *map_lists[OMP_MAP_LIST_LAST]; enum gfc_omp_sched_kind sched_kind; struct gfc_expr *chunk_size; enum gfc_omp_default_sharing default_sharing; diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c index 7b87e78..1cf9128 100644 --- gcc/fortran/openmp.c +++ gcc/fortran/openmp.c @@ -86,6 +86,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->non_clause_wait_expr); for (i = 0; i < OMP_LIST_NUM; i++) gfc_free_omp_namelist (c->lists[i]); + for (i = 0; i < OMP_MAP_LIST_LAST; i++) + gfc_free_expr_list (c->map_lists[i]); gfc_free_expr_list (c->wait_list); gfc_free_expr_list (c->tile_list); free (c); @@ -2475,6 +2477,24 @@ oacc_is_loop (gfc_code *code) || code->op == EXEC_OACC_LOOP; } +/* TODO: use OpenMP 4 target infrastructure. */ +static const char* +map_list_to_ascii (gfc_code *code, int list) +{ + gcc_assert (code->op == EXEC_OMP_TARGET); + + switch (list) + { + case OMP_MAP_LIST_ALLOC: + case OMP_MAP_LIST_TO: + case OMP_MAP_LIST_FROM: + case OMP_MAP_LIST_TOFROM: + return ("MAP"); + default: + gcc_unreachable (); + } +} + static void resolve_oacc_scalar_int_expr (gfc_expr *expr, const char *clause) { @@ -2560,6 +2580,32 @@ resolve_oacc_data_clauses (gfc_symbol *sym, locus loc, const char *name) check_array_not_assumed (sym, loc, name); } +/* TODO: use OpenMP 4 target infrastructure. */ +static void +resolve_omp_map_clauses (gfc_symbol *sym, locus loc) +{ + const char *name = "MAP"; + if (sym->ts.type == BT_DERIVED && sym->attr.allocatable) + gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L", + sym->name, name, &loc); + if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable) + || (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && CLASS_DATA (sym)->attr.allocatable)) + gfc_error ("ALLOCATABLE object '%s' of polymorphic type " + "in %s clause at %L", sym->name, name, &loc); + check_symbol_not_pointer (sym, loc, name); + if (sym->as && sym->as->type == AS_ASSUMED_RANK) + gfc_error ("Assumed rank array '%s' in %s clause at %L", + sym->name, name, &loc); + if (sym->as && sym->as->type == AS_DEFERRED && sym->attr.pointer + && !sym->attr.contiguous) + gfc_error ("Noncontiguous deferred shape array '%s' in %s clause at %L", + sym->name, name, &loc); + if (sym->attr.threadprivate) + gfc_error ("Threadprivate variable '%s' is not allowed in %s clause at %L", + sym->name, name, &loc); +} + static void resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name) { @@ -2688,6 +2734,59 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns, } +/* TODO: use OpenMP 4 target infrastructure. */ +static void +resolve_omp_array_section (gfc_array_ref *ar, gfc_code *code, + const char *clause, const char *sym_name, + bool component) +{ + int i; + const char *str; + + switch (code->op) + { + case EXEC_OACC_KERNELS: + case EXEC_OACC_PARALLEL: + case EXEC_OACC_DATA: + case EXEC_OACC_CACHE: + str = "OpenACC subarray"; + break; + default: + str = "OpenMP array section"; + } + if (ar->type == AR_UNKNOWN) + { + gfc_error ("Expression in %s clause is not %s of " + "array '%s' at %L", clause, str, sym_name, &code->loc); + return; + } + if (component && ar->type == AR_FULL) + { + gfc_error ("Component of derived type '%s' in %s clause must be single " + "array element or %s at %L", sym_name, clause, str, + &code->loc); + return; + } + for (i = 0; i < ar->as->rank; i++) + { + gfc_expr *start = ar->start[i]; + gfc_expr *end = ar->end[i]; + if (ar->stride[i]) + { + gfc_error ("Stride is not allowed in %s at %L", str, &ar->c_where[i]); + continue; + } + /* Since stride is not allowed, lower bound cannot be greater + than upper one. */ + if (start && end + && mpz_cmp (start->value.integer, end->value.integer) > 0) + gfc_error ("Lower bound of %s in greater than " + "upper (%ld > %ld) at %L", str, + mpz_get_si (start->value.integer), + mpz_get_si (end->value.integer), &ar->c_where[i]); + } +} + /* OpenMP directive resolving routines. */ static void @@ -2862,6 +2961,89 @@ resolve_omp_clauses (gfc_code *code, locus *where, n->sym->mark = 1; } + for (list = 0; list < OMP_MAP_LIST_LAST; list++) + for (el = omp_clauses->map_lists[list]; el; el = el->next) + { + gfc_ref *ref; + gfc_symbol *sym; + bool component = false; + + gfc_resolve_expr (el->expr); + + if (el->expr->expr_type != EXPR_VARIABLE) + { + gfc_error ("Expression in %s clause is not a variable at %L", + map_list_to_ascii (code, list), &code->loc); + continue; + } + + sym = el->expr->symtree->n.sym; + sym->mark = 0; + if (sym->attr.flavor != FL_VARIABLE && !sym->attr.proc_pointer) + { + gfc_error ("Object '%s' is not a variable at %L", sym->name, + &code->loc); + continue; + } + + if (el->expr->ts.type == BT_CLASS) + { + gfc_error ("CLASS object '%s' cannot appear in %s clause at %L", + sym->name, map_list_to_ascii (code, list), &code->loc); + continue; + } + + if (el->expr->rank != 0 && !gfc_is_simply_contiguous(el->expr, false)) + { + gfc_error ("Object %s in %s clause is not contiguous at %L", + sym->name, map_list_to_ascii (code, list), &code->loc); + continue; + } + + for (ref = el->expr->ref; ref; ref = ref->next) + if (ref->type == REF_ARRAY) + resolve_omp_array_section (&ref->u.ar, code, + map_list_to_ascii (code, list), + sym->name, component); + else if (ref->type == REF_COMPONENT) + { + if (!ref->u.c.component->as) + { + gfc_error ("Component '%s' of derived type in %s clause must " + "be single array element or array section at %L", + ref->u.c.component->name, + map_list_to_ascii (code, list), &code->loc); + continue; + } + component = true; + } + else if (ref->type == REF_SUBSTRING) + gfc_error ("Substrings are not allowed in array section in %s " + "clause at %L", map_list_to_ascii (code, list), + &code->loc); + else + gcc_unreachable (); + } + + + for (list = 0; list < OMP_MAP_LIST_LAST; list++) + for (el = omp_clauses->map_lists[list]; el; el = el->next) + { + gfc_symbol *sym; + + if (el->expr->expr_type != EXPR_VARIABLE) + continue; + + sym = el->expr->symtree->n.sym; + if (sym->mark) + gfc_error ("Symbol '%s' present on multiple clauses at %L", + sym->name, &code->loc); + else + sym->mark = 1; + + resolve_omp_map_clauses (sym, code->loc); + } + for (list = 0; list < OMP_LIST_NUM; list++) if ((n = omp_clauses->lists[list]) != NULL) { diff --git gcc/fortran/trans-openmp.c gcc/fortran/trans-openmp.c index aaf50d3..96d5cd9 100644 --- gcc/fortran/trans-openmp.c +++ gcc/fortran/trans-openmp.c @@ -1687,7 +1687,7 @@ gfc_trans_omp_reduction_list (gfc_omp_namelist *namelist, tree list, static tree gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind, - gfc_omp_namelist *namelist, tree list) + gfc_omp_namelist *namelist, tree list, locus where) { for (; namelist != NULL; namelist = namelist->next) if (namelist->sym->attr.referenced) @@ -1695,7 +1695,7 @@ gfc_trans_omp_map_clause_list (enum omp_clause_map_kind kind, tree t = gfc_trans_omp_variable (namelist->sym, false); if (t != error_mark_node) { - tree node = build_omp_clause (input_location, OMP_CLAUSE_MAP); + tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP); OMP_CLAUSE_DECL (node) = t; OMP_CLAUSE_MAP_KIND (node) = kind; list = gfc_trans_add_clause (node, list); @@ -1719,6 +1719,23 @@ gfc_convert_expr_to_tree (stmtblock_t *block, gfc_expr *expr) return result; } +/* TODO: use OpenMP 4 target infrastructure. */ +static tree +gfc_convert_array_section_to_array_ref (gfc_array_ref ar, gfc_expr *expr, + tree t) +{ + gfc_se se; + int i; + for (i = 0; i < ar.dimen; i++) + if (ar.start[i] == NULL) + ar.start[i] = ar.as->lower[i]; + ar.type = AR_ELEMENT; + gfc_init_se (&se, NULL); + se.expr = t; + gfc_conv_array_ref (&se, &ar, expr, &expr->where); + return se.expr; +} + static tree gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, locus where, bool declare_simd = false) @@ -1779,7 +1796,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, default: gcc_unreachable (); } - omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses); + omp_clauses = gfc_trans_omp_map_clause_list (kind, n, omp_clauses, where); continue; } switch (list) @@ -2336,6 +2353,128 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, omp_clauses = gfc_trans_add_clause (c, omp_clauses); } + for (int kind = OMP_MAP_LIST_ALLOC; kind < OMP_MAP_LIST_LAST; kind++) + { + enum omp_clause_map_kind type; + gfc_expr_list *el = clauses->map_lists[kind]; + + if (el == NULL) + continue; + + switch (kind) + { + case OMP_MAP_LIST_ALLOC: + type = OMP_CLAUSE_MAP_ALLOC; + break; + case OMP_MAP_LIST_TO: + type = OMP_CLAUSE_MAP_TO; + break; + case OMP_MAP_LIST_FROM: + type = OMP_CLAUSE_MAP_FROM; + break; + case OMP_MAP_LIST_TOFROM: + type = OMP_CLAUSE_MAP_TOFROM; + break; + default: + gcc_unreachable (); + } + for (; el; el = el->next) + { + gfc_symbol *sym; + tree t, var_decl = NULL_TREE; + tree size = NULL_TREE, bias = NULL_TREE; + + gcc_assert (el->expr->expr_type == EXPR_VARIABLE); + sym = el->expr->symtree->n.sym; + + if (!sym->attr.referenced) + continue; + + t = gfc_trans_omp_variable (sym, false); + if (el->expr->ref) + { + gfc_ref *ref = el->expr->ref; + for (; ref; ref = ref->next) + if (ref->type == REF_ARRAY) + if (ref->u.ar.type == AR_SECTION) + { + mpz_t ar_size, ar_kind, ar_bias; + bool computable; + int i; + + /* In OpenMP implementation array sections are represented + as ARRAY_REF tree node with SIZE (in bytes). + Also one need to set bias of array section. */ + var_decl = t; + t = gfc_convert_array_section_to_array_ref (ref->u.ar, + el->expr, t); + computable = gfc_array_size(el->expr, &ar_size); + gcc_assert (computable); + mpz_init_set_ui (ar_kind, el->expr->ts.kind); + mpz_init_set_ui (ar_bias, el->expr->ts.kind); + mpz_mul (ar_size, ar_size, ar_kind); + for (i = 0; i < ref->u.ar.dimen; i++) + { + mpz_t start, end, diff; + mpz_init (end); + mpz_init (diff); + mpz_init_set (start, + ref->u.ar.as->lower[i]->value.integer); + if (i < ref->u.ar.dimen - 1) + mpz_set (end, ref->u.ar.as->upper[i]->value.integer); + else + mpz_set (end, ref->u.ar.start[i]->value.integer); + mpz_sub (diff, end, start); + if (i < ref->u.ar.dimen - 1) + mpz_add_ui (diff, diff, 1); + mpz_mul (ar_bias, ar_bias, diff); + mpz_clear (start); + mpz_clear (end); + mpz_clear (diff); + } + size = gfc_conv_mpz_to_tree (ar_size, el->expr->ts.kind); + bias = gfc_conv_mpz_to_tree (ar_bias, el->expr->ts.kind); + mpz_clear (ar_size); + mpz_clear (ar_kind); + mpz_clear (ar_bias); + } + else if (ref->u.ar.type == AR_ELEMENT) + { + gfc_init_se (&se, NULL); + se.expr = t; + gfc_conv_array_ref (&se, &ref->u.ar, el->expr, + &el->expr->where); + t = se.expr; + size = build_int_cst (gfc_array_index_type, + gfc_index_integer_kind); + } + else if (ref->u.ar.type == AR_FULL) + ; /* Nothing to do: T already contains necessary data. */ + else + gcc_unreachable (); + else + gcc_unreachable (); + } + if (t != error_mark_node) + { + tree node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP); + OMP_CLAUSE_DECL (node) = t; + OMP_CLAUSE_MAP_KIND (node) = type; + if (size) + OMP_CLAUSE_SIZE (node) = size; + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + if (bias) + { + node = build_omp_clause (where.lb->location, OMP_CLAUSE_MAP); + OMP_CLAUSE_DECL (node) = var_decl; + OMP_CLAUSE_MAP_KIND (node) = OMP_CLAUSE_MAP_POINTER; + OMP_CLAUSE_SIZE (node) = bias; + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + } + } + if (clauses->nowait) { c = build_omp_clause (where.lb->location, OMP_CLAUSE_NOWAIT); diff --git gcc/testsuite/gfortran.dg/goacc/subarrays.f95 gcc/testsuite/gfortran.dg/goacc/subarrays.f95 new file mode 100644 index 0000000..4740dab --- /dev/null +++ gcc/testsuite/gfortran.dg/goacc/subarrays.f95 @@ -0,0 +1,36 @@ +! { dg-do compile } +program test + implicit none + integer :: a(10), b(10, 10), c(3:7), i + + !$acc parallel copy(a(1:5)) + !$acc end parallel + !$acc parallel copy(a(1 + 0 : 5 + 2)) + !$acc end parallel + !$acc parallel copy(a(:3)) + !$acc end parallel + !$acc parallel copy(a(3:)) + !$acc end parallel + !$acc parallel copy(a(:)) ! { dg-error "Syntax error in variable list" } + !$acc parallel copy(a(2:3,2:3)) ! { dg-error "Number of dimensions" } + !$acc end parallel + ! TODO: there must be warning + !$acc parallel copy (a(:11)) + !$acc end parallel + !$acc parallel copy (a(i:)) + !$acc end parallel + + !$acc parallel copy (a(:b)) ! { dg-error "scalar INTEGER expression" } + !$acc end parallel + + !$acc parallel copy (b(1:3,2:4)) + !$acc end parallel + !$acc parallel copy (b(2:3)) ! { dg-error "Number of dimensions" } + !$acc end parallel + !$acc parallel copy (b(1:, 4:6)) ! { dg-warning "whole dimension" } + !$acc end parallel + + ! TODO: there must be warning + !$acc parallel copy (c(2:)) + !$acc end parallel +end program test \ No newline at end of file diff --git gcc/testsuite/gfortran.dg/gomp/map-1.f90 gcc/testsuite/gfortran.dg/gomp/map-1.f90 new file mode 100644 index 0000000..603d19d --- /dev/null +++ gcc/testsuite/gfortran.dg/gomp/map-1.f90 @@ -0,0 +1,109 @@ +subroutine test(aas) + implicit none + + integer :: i, j(10), k(10, 10), aas(*) + integer, save :: tp + !$omp threadprivate(tp) + integer, parameter :: p = 1 + + type t + integer :: i, j(10) + end type t + + type(t) :: tt + + !$omp target map(i) + !$omp end target + + !$omp target map(j) + !$omp end target + + !$omp target map(p) ! { dg-error "Object 'p' is not a variable" } + !$omp end target + + !$omp target map(j(1)) + !$omp end target + + !$omp target map(j(i)) + !$omp end target + + !$omp target map(j(i:)) + !$omp end target + + !$omp target map(j(:i)) + !$omp end target + + !$omp target map(j(i:i+1)) + !$omp end target + + !$omp target map(j(11)) ! { dg-warning "out of bounds" } + !$omp end target + + !$omp target map(j(:11)) ! { dg-warning "out of bounds" } + !$omp end target + + !$omp target map(j(0:)) ! { dg-warning "out of bounds" } + !$omp end target + + !$omp target map(j(5:4)) ! { dg-error "Lower bound of OpenMP array section in greater than upper" "" { xfail *-*-* } } + !$omp end target + + !$omp target map(j(5:)) + !$omp end target + + !$omp target map(j(:5)) + !$omp end target + + !$omp target map(j(:)) + !$omp end target + + !$omp target map(j(1:9:2)) ! { dg-error "Stride should not be specified for array section in MAP clause" } + !$omp end target + + !$omp target map(aas(5:)) + !$omp end target + ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 63 } + ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 63 } + + !$omp target map(aas(:)) + !$omp end target + ! { dg-error "Rightmost upper bound of assumed size array section not specified" "" { target *-*-* } 68 } + ! { dg-error "'aas' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 68 } + + !$omp target map(aas) ! { dg-error "The upper bound in the last dimension must appear" "" { xfail *-*-* } } + !$omp end target + + !$omp target map(aas(5:7)) + !$omp end target + + !$omp target map(aas(:7)) + !$omp end target + + !$omp target map(k(5:)) + !$omp end target + ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 82 } + ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 82 } + + !$omp target map(k(5:,:,3)) + !$omp end target + ! { dg-error "Rank mismatch in array reference" "" { target *-*-* } 87 } + ! { dg-error "'k' in MAP clause at \\\(1\\\) is not a proper array section" "" { target *-*-* } 87 } + + !$omp target map(tt) + !$omp end target + + !$omp target map(tt%i) ! { dg-error "Syntax error in OpenMP variable list" } + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } } + + !$omp target map(tt%j) ! { dg-error "Syntax error in OpenMP variable list" } + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } } + + !$omp target map(tt%j(1)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } } + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } } + + !$omp target map(tt%j(1:)) ! { dg-bogus "Syntax error in OpenMP variable list" "" { xfail *-*-* } } + !$omp end target ! { dg-bogus "Unexpected !\\\$OMP END TARGET statement" "" { xfail *-*-* } } + + !$omp target map(tp) ! { dg-error "THREADPRIVATE object 'tp' in MAP clause" } + !$omp end target +end subroutine test \ No newline at end of file Also, I think the following is wanted, too, to allow subarray specifications for all OpenACC data clauses: --- gcc/fortran/openmp.c +++ gcc/fortran/openmp.c @@ -577,80 +577,86 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned long long mask, continue; if ((mask & OMP_CLAUSE_COPY) && gfc_match_omp_variable_list ("copy (", - &c->lists[OMP_LIST_COPY], true) + &c->lists[OMP_LIST_COPY], true, + NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_OACC_COPYIN) && gfc_match_omp_variable_list ("copyin (", - &c->lists[OMP_LIST_OACC_COPYIN], true) + &c->lists[OMP_LIST_OACC_COPYIN], true, + NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_COPYOUT) && gfc_match_omp_variable_list ("copyout (", - &c->lists[OMP_LIST_COPYOUT], true) + &c->lists[OMP_LIST_COPYOUT], true, + NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_CREATE) && gfc_match_omp_variable_list ("create (", - &c->lists[OMP_LIST_CREATE], true) + &c->lists[OMP_LIST_CREATE], true, + NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_DELETE) && gfc_match_omp_variable_list ("delete (", - &c->lists[OMP_LIST_DELETE], true) + &c->lists[OMP_LIST_DELETE], true, + NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT) && gfc_match_omp_variable_list ("present (", - &c->lists[OMP_LIST_PRESENT], true) + &c->lists[OMP_LIST_PRESENT], true, + NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) && gfc_match_omp_variable_list ("present_or_copy (", &c->lists[OMP_LIST_PRESENT_OR_COPY], - true) + true, NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT_OR_COPY) && gfc_match_omp_variable_list ("pcopy (", &c->lists[OMP_LIST_PRESENT_OR_COPY], - true) + true, NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN) && gfc_match_omp_variable_list ("present_or_copyin (", &c->lists[OMP_LIST_PRESENT_OR_COPYIN], - true) + true, NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT_OR_COPYIN) && gfc_match_omp_variable_list ("pcopyin (", &c->lists[OMP_LIST_PRESENT_OR_COPYIN], - true) + true, NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT) && gfc_match_omp_variable_list ("present_or_copyout (", &c->lists[OMP_LIST_PRESENT_OR_COPYOUT], - true) + true, NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT_OR_COPYOUT) && gfc_match_omp_variable_list ("pcopyout (", &c->lists[OMP_LIST_PRESENT_OR_COPYOUT], - true) + true, NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) && gfc_match_omp_variable_list ("present_or_create (", &c->lists[OMP_LIST_PRESENT_OR_CREATE], - true) + true, NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_PRESENT_OR_CREATE) && gfc_match_omp_variable_list ("pcreate (", &c->lists[OMP_LIST_PRESENT_OR_CREATE], - true) + true, NULL, NULL, true) == MATCH_YES) continue; if ((mask & OMP_CLAUSE_DEVICEPTR)