From patchwork Wed Feb 1 11:59:07 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Thomas Schwinge X-Patchwork-Id: 64081 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id E272F385B51C for ; Wed, 1 Feb 2023 11:59:50 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa2.mentor.iphmx.com (esa2.mentor.iphmx.com [68.232.141.98]) by sourceware.org (Postfix) with ESMTPS id 8890F3858D37; Wed, 1 Feb 2023 11:59:17 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 8890F3858D37 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com X-IronPort-AV: E=Sophos;i="5.97,263,1669104000"; d="scan'208,223";a="96526720" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa2.mentor.iphmx.com with ESMTP; 01 Feb 2023 03:59:15 -0800 IronPort-SDR: PXKqrsiUInMEiWOZ/6Hpm3SIZePwQjFBOJ77RaSPNNaVxOo5nSeDhNlpbKCK/jkGGXBQmKgxw/ i1Ubh6ng3MEZrKH44tP23X95dMT6091otoUsVYcPrbZCI4ZOLJjK0CM/QjZyn1TEI0Fgq+BPsZ AN3UKIo0FyCw8kRNOgtQNu2iyvsx+MPsgwadEKZKEQsE6/2hPYIuHntB9vPJDcgjDEaNZEGKUE xua/i3BOQNBCu1hsMshQ0bk599rgNCpUO6onSL4pxid7gFtUvl+Z3nxKzqFCwlumFnVtr9XQFJ H0w= From: Thomas Schwinge To: Hafiz Abid Qadeer , , CC: Jakub Jelinek , Tobias Burnus Subject: [og12] Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90' (was: [PATCH 1/5] [gfortran] Add parsing support for allocate directive (OpenMP 5.0).) In-Reply-To: <20220113145320.3153087-2-abidh@codesourcery.com> References: <20220113145320.3153087-1-abidh@codesourcery.com> <20220113145320.3153087-2-abidh@codesourcery.com> User-Agent: Notmuch/0.29.3+94~g74c3f1b (https://notmuchmail.org) Emacs/28.2 (x86_64-pc-linux-gnu) Date: Wed, 1 Feb 2023 12:59:07 +0100 Message-ID: <875yclppf8.fsf@euler.schwinge.homeip.net> MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-10.mgc.mentorg.com (139.181.222.10) To svr-ies-mbx-10.mgc.mentorg.com (139.181.222.10) X-Spam-Status: No, score=-11.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, RCVD_IN_MSPIKE_H2, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Hi! On 2022-01-13T14:53:16+0000, Hafiz Abid Qadeer wrote: > Currently we only make use of this directive when it is associated > with an allocate statement. These changes (or a variant thereof; haven't checked) are present on devel/omp/gcc-12 branch as commit 491478d12b83e102f72858e8a871a25c951df293 "Add parsing support for allocate directive (OpenMP 5.0)". I've noticed that while this new test case 'gfortran.dg/gomp/allocate-4.f90': > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 > @@ -0,0 +1,112 @@ > +! { dg-do compile } > + > +module test > + integer, allocatable :: mvar1 > + integer, allocatable :: mvar2 > + integer, allocatable :: mvar3 > +end module > + > +subroutine foo(x, y) > + use omp_lib > + implicit none > + integer :: x > + integer :: y > + > + integer, allocatable :: var1(:) > + integer, allocatable :: var2(:) > + integer, allocatable :: var3(:) > + integer, allocatable :: var4(:) > + integer, allocatable :: var5(:) > + integer, allocatable :: var6(:) > + integer, allocatable :: var7(:) > + integer, allocatable :: var8(:) > + integer, allocatable :: var9(:) > + > + !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } > + allocate (var1(x)) > + > + !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } > + allocate (var3(x)) > +[...] ... is all-PASS for x86_64-pc-linux-gnu (default) '-m64' testing, is does have one FAIL for '-m32' testing: 'test for errors, line 25'. Here's the 'diff': @@ -1,8 +1,3 @@ -source-gcc/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:25:34: - - 25 | !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } - | 1 -Error: Expected integer expression of the ‘omp_allocator_handle_kind’ kind at (1) source-gcc/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:28:130: 28 | !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } OK to push to devel/omp/gcc-12 branch the attached "Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90'", or is a different solution called for? Grüße Thomas > gcc/fortran/ChangeLog: > > * dump-parse-tree.c (show_omp_node): Handle EXEC_OMP_ALLOCATE. > (show_code_node): Likewise. > * gfortran.h (enum gfc_statement): Add ST_OMP_ALLOCATE. > (OMP_LIST_ALLOCATOR): New enum value. > (enum gfc_exec_op): Add EXEC_OMP_ALLOCATE. > * match.h (gfc_match_omp_allocate): New function. > * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATOR. > (OMP_ALLOCATE_CLAUSES): New define. > (gfc_match_omp_allocate): New function. > (resolve_omp_clauses): Add ALLOCATOR in clause_names. > (omp_code_to_statement): Handle EXEC_OMP_ALLOCATE. > (EMPTY_VAR_LIST): New define. > (check_allocate_directive_restrictions): New function. > (gfc_resolve_omp_allocate): Likewise. > (gfc_resolve_omp_directive): Handle EXEC_OMP_ALLOCATE. > * parse.c (decode_omp_directive): Handle ST_OMP_ALLOCATE. > (next_statement): Likewise. > (gfc_ascii_statement): Likewise. > * resolve.c (gfc_resolve_code): Handle EXEC_OMP_ALLOCATE. > * st.c (gfc_free_statement): Likewise. > * trans.c (trans_code): Likewise > > gcc/testsuite/ChangeLog: > > * gfortran.dg/gomp/allocate-4.f90: New test. > * gfortran.dg/gomp/allocate-5.f90: New test. > --- > gcc/fortran/dump-parse-tree.c | 3 + > gcc/fortran/gfortran.h | 4 +- > gcc/fortran/match.h | 1 + > gcc/fortran/openmp.c | 199 +++++++++++++++++- > gcc/fortran/parse.c | 10 +- > gcc/fortran/resolve.c | 1 + > gcc/fortran/st.c | 1 + > gcc/fortran/trans.c | 1 + > gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 112 ++++++++++ > gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 | 73 +++++++ > 10 files changed, 400 insertions(+), 5 deletions(-) > create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 > create mode 100644 gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 > > diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c > index 7459f4b89a9..38fef42150a 100644 > --- a/gcc/fortran/dump-parse-tree.c > +++ b/gcc/fortran/dump-parse-tree.c > @@ -1993,6 +1993,7 @@ show_omp_node (int level, gfc_code *c) > case EXEC_OACC_CACHE: name = "CACHE"; is_oacc = true; break; > case EXEC_OACC_ENTER_DATA: name = "ENTER DATA"; is_oacc = true; break; > case EXEC_OACC_EXIT_DATA: name = "EXIT DATA"; is_oacc = true; break; > + case EXEC_OMP_ALLOCATE: name = "ALLOCATE"; break; > case EXEC_OMP_ATOMIC: name = "ATOMIC"; break; > case EXEC_OMP_BARRIER: name = "BARRIER"; break; > case EXEC_OMP_CANCEL: name = "CANCEL"; break; > @@ -2194,6 +2195,7 @@ show_omp_node (int level, gfc_code *c) > || c->op == EXEC_OMP_TARGET_UPDATE || c->op == EXEC_OMP_TARGET_ENTER_DATA > || c->op == EXEC_OMP_TARGET_EXIT_DATA || c->op == EXEC_OMP_SCAN > || c->op == EXEC_OMP_DEPOBJ || c->op == EXEC_OMP_ERROR > + || c->op == EXEC_OMP_ALLOCATE > || (c->op == EXEC_OMP_ORDERED && c->block == NULL)) > return; > if (c->op == EXEC_OMP_SECTIONS || c->op == EXEC_OMP_PARALLEL_SECTIONS) > @@ -3314,6 +3316,7 @@ show_code_node (int level, gfc_code *c) > case EXEC_OACC_CACHE: > case EXEC_OACC_ENTER_DATA: > case EXEC_OACC_EXIT_DATA: > + case EXEC_OMP_ALLOCATE: > case EXEC_OMP_ATOMIC: > case EXEC_OMP_CANCEL: > case EXEC_OMP_CANCELLATION_POINT: > diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h > index 3b791a4f6be..79a43a2fdf0 100644 > --- a/gcc/fortran/gfortran.h > +++ b/gcc/fortran/gfortran.h > @@ -259,7 +259,7 @@ enum gfc_statement > ST_OACC_CACHE, ST_OACC_KERNELS_LOOP, ST_OACC_END_KERNELS_LOOP, > ST_OACC_SERIAL_LOOP, ST_OACC_END_SERIAL_LOOP, ST_OACC_SERIAL, > ST_OACC_END_SERIAL, ST_OACC_ENTER_DATA, ST_OACC_EXIT_DATA, ST_OACC_ROUTINE, > - ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, > + ST_OACC_ATOMIC, ST_OACC_END_ATOMIC, ST_OMP_ALLOCATE, > ST_OMP_ATOMIC, ST_OMP_BARRIER, ST_OMP_CRITICAL, ST_OMP_END_ATOMIC, > ST_OMP_END_CRITICAL, ST_OMP_END_DO, ST_OMP_END_MASTER, ST_OMP_END_ORDERED, > ST_OMP_END_PARALLEL, ST_OMP_END_PARALLEL_DO, ST_OMP_END_PARALLEL_SECTIONS, > @@ -1392,6 +1392,7 @@ enum > OMP_LIST_USE_DEVICE_PTR, > OMP_LIST_USE_DEVICE_ADDR, > OMP_LIST_NONTEMPORAL, > + OMP_LIST_ALLOCATOR, > OMP_LIST_NUM > }; > > @@ -2893,6 +2894,7 @@ enum gfc_exec_op > 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_ALLOCATE, > 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, > diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h > index 65ee3b6cb41..9f0449eda0e 100644 > --- a/gcc/fortran/match.h > +++ b/gcc/fortran/match.h > @@ -149,6 +149,7 @@ match gfc_match_oacc_routine (void); > > /* OpenMP directive matchers. */ > match gfc_match_omp_eos_error (void); > +match gfc_match_omp_allocate (void); > match gfc_match_omp_atomic (void); > match gfc_match_omp_barrier (void); > match gfc_match_omp_cancel (void); > diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c > index 86c412a4334..ee7c39980bb 100644 > --- a/gcc/fortran/openmp.c > +++ b/gcc/fortran/openmp.c > @@ -921,6 +921,7 @@ enum omp_mask1 > OMP_CLAUSE_FAIL, /* OpenMP 5.1. */ > OMP_CLAUSE_WEAK, /* OpenMP 5.1. */ > OMP_CLAUSE_NOWAIT, > + OMP_CLAUSE_ALLOCATOR, > /* This must come last. */ > OMP_MASK1_LAST > }; > @@ -3568,6 +3569,7 @@ cleanup: > } > > > +#define OMP_ALLOCATE_CLAUSES (omp_mask (OMP_CLAUSE_ALLOCATOR)) > #define OMP_PARALLEL_CLAUSES \ > (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ > | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \ > @@ -5762,6 +5764,64 @@ gfc_match_omp_ordered_depend (void) > return match_omp (EXEC_OMP_ORDERED, omp_mask (OMP_CLAUSE_DEPEND)); > } > > +/* omp allocate (list) [clause-list] > + - clause-list: allocator > +*/ > + > +match > +gfc_match_omp_allocate (void) > +{ > + gfc_omp_clauses *c = gfc_get_omp_clauses (); > + gfc_expr *allocator = NULL; > + match m; > + > + m = gfc_match (" ("); > + if (m == MATCH_YES) > + { > + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATOR], > + true, NULL); > + > + if (m != MATCH_YES) > + { > + /* If the list was empty, we must find closing ')'. */ > + m = gfc_match (")"); > + if (m != MATCH_YES) > + return m; > + } > + } > + > + if (gfc_match (" allocator ( ") == MATCH_YES) > + { > + m = gfc_match_expr (&allocator); > + if (m != MATCH_YES) > + { > + gfc_error ("Expected allocator at %C"); > + return MATCH_ERROR; > + } > + if (gfc_match (" ) ") != MATCH_YES) > + { > + gfc_error ("Expected ')' at %C"); > + gfc_free_expr (allocator); > + return MATCH_ERROR; > + } > + } > + > + if (gfc_match_omp_eos () != MATCH_YES) > + { > + gfc_free_expr (allocator); > + gfc_error ("Unexpected junk after $OMP allocate at %C"); > + return MATCH_ERROR; > + } > + gfc_omp_namelist *n; > + for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next) > + n->expr = gfc_copy_expr (allocator); > + > + new_st.op = EXEC_OMP_ALLOCATE; > + new_st.ext.omp_clauses = c; > + gfc_free_expr (allocator); > + return MATCH_YES; > +} > + > > /* omp atomic [clause-list] > - atomic-clause: read | write | update > @@ -6243,7 +6303,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, > "IN_REDUCTION", "TASK_REDUCTION", > "DEVICE_RESIDENT", "LINK", "USE_DEVICE", > "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", > - "NONTEMPORAL" }; > + "NONTEMPORAL", "ALLOCATOR" }; > STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM); > > if (omp_clauses == NULL) > @@ -8507,6 +8567,8 @@ omp_code_to_statement (gfc_code *code) > { > switch (code->op) > { > + case EXEC_OMP_ALLOCATE: > + return ST_OMP_ALLOCATE; > case EXEC_OMP_PARALLEL: > return ST_OMP_PARALLEL; > case EXEC_OMP_PARALLEL_MASKED: > @@ -8987,6 +9049,138 @@ gfc_resolve_oacc_routines (gfc_namespace *ns) > } > } > > +static void > +check_allocate_directive_restrictions (gfc_symbol *sym, gfc_expr *omp_al, > + gfc_namespace *ns, locus loc) > +{ > + if (sym->attr.save != SAVE_NONE || sym->attr.in_common == 1 > + || sym->module != NULL) > + { > + int tmp; > + /* Assumption here is that we can extract an integer then > + it is a predefined thing. */ > + if (!omp_al || gfc_extract_int (omp_al, &tmp)) > + gfc_error ("%qs should use predefined allocator at %L", sym->name, > + &loc); > + } > + if (ns != sym->ns) > + gfc_error ("%qs is not in the same scope as %" > + " directive at %L", sym->name, &loc); > +} > + > +#define EMPTY_VAR_LIST(node) \ > + (node->ext.omp_clauses->lists[OMP_LIST_ALLOCATOR] == NULL) > + > +static void > +gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns) > +{ > + gfc_alloc *al; > + gfc_omp_namelist *n = NULL; > + gfc_omp_namelist *cn = NULL; > + gfc_omp_namelist *p, *tail; > + gfc_code *cur; > + hash_set vars; > + > + gfc_omp_clauses *clauses = code->ext.omp_clauses; > + gcc_assert (clauses); > + cn = clauses->lists[OMP_LIST_ALLOCATOR]; > + gfc_expr *omp_al = cn ? cn->expr : NULL; > + > + if (omp_al && (omp_al->ts.type != BT_INTEGER > + || omp_al->ts.kind != gfc_c_intptr_kind)) > + gfc_error ("Expected integer expression of the " > + "% kind at %L", &omp_al->where); > + > + /* Check that variables in this allocate directive are not duplicated > + in this directive or others coming directly after it. */ > + for (cur = code; cur != NULL && cur->op == EXEC_OMP_ALLOCATE; > + cur = cur->next) > + { > + gfc_omp_clauses *c = cur->ext.omp_clauses; > + gcc_assert (c); > + for (n = c->lists[OMP_LIST_ALLOCATOR]; n; n = n->next) > + { > + if (vars.contains (n->sym)) > + gfc_error ("%qs is used in multiple % " > + "directives at %L", n->sym->name, &cur->loc); > + /* This helps us avoid duplicate error messages. */ > + if (cur == code) > + vars.add (n->sym); > + } > + } > + > + if (cur == NULL || cur->op != EXEC_ALLOCATE) > + { > + /* There is no allocate statement right after allocate directive. > + We don't support this case at the moment. */ > + for (n = cn; n != NULL; n = n->next) > + { > + gfc_symbol *sym = n->sym; > + if (sym->attr.allocatable == 1) > + gfc_error ("%qs with ALLOCATABLE attribute is not allowed in " > + "% directive at %L as this directive is not" > + " associated with an % statement.", > + sym->name, &code->loc); > + } > + sorry_at (code->loc.lb->location, "% directive that is " > + "not associated with an % statement is not " > + "supported."); > + return; > + } > + > + /* If there is another allocate directive right after this one, check > + that none of them is empty. Doing it this way, we can check this > + thing even when multiple directives are together and generate > + error at right location. */ > + if (code->next && code->next->op == EXEC_OMP_ALLOCATE > + && (EMPTY_VAR_LIST (code) || EMPTY_VAR_LIST (code->next))) > + gfc_error ("Empty variable list is not allowed at %L when multiple " > + "% directives are associated with an " > + "% statement.", > + EMPTY_VAR_LIST (code) ? &code->loc : &code->next->loc); > + > + if (EMPTY_VAR_LIST (code)) > + { > + /* Empty namelist means allocate directive applies to all > + variables in allocate statement. 'cur' points to associated > + allocate statement. */ > + for (al = cur->ext.alloc.list; al != NULL; al = al->next) > + if (al->expr && al->expr->symtree && al->expr->symtree->n.sym) > + { > + check_allocate_directive_restrictions (al->expr->symtree->n.sym, > + omp_al, ns, code->loc); > + p = gfc_get_omp_namelist (); > + p->sym = al->expr->symtree->n.sym; > + p->expr = omp_al; > + p->where = code->loc; > + if (cn == NULL) > + cn = tail = p; > + else > + { > + tail->next = p; > + tail = tail->next; > + } > + } > + clauses->lists[OMP_LIST_ALLOCATOR]= cn; > + } > + else > + { > + for (n = cn; n != NULL; n = n->next) > + { > + for (al = cur->ext.alloc.list; al != NULL; al = al->next) > + if (al->expr && al->expr->symtree && al->expr->symtree->n.sym > + && al->expr->symtree->n.sym == n->sym) > + break; > + if (al == NULL) > + gfc_error ("%qs in % directive at %L is not present " > + "in associated % statement.", > + n->sym->name, &code->loc); > + check_allocate_directive_restrictions (n->sym, omp_al, ns, > + code->loc); > + } > + } > +} > + > > void > gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) > @@ -9128,6 +9322,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) > code->ext.omp_clauses->if_present = false; > resolve_omp_clauses (code, code->ext.omp_clauses, ns); > break; > + case EXEC_OMP_ALLOCATE: > + gfc_resolve_omp_allocate (code, ns); > + break; > default: > break; > } > diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c > index c04ad774f25..fda36433129 100644 > --- a/gcc/fortran/parse.c > +++ b/gcc/fortran/parse.c > @@ -886,6 +886,7 @@ decode_omp_directive (void) > { > case 'a': > matcho ("atomic", gfc_match_omp_atomic, ST_OMP_ATOMIC); > + matcho ("allocate", gfc_match_omp_allocate, ST_OMP_ALLOCATE); > break; > case 'b': > matcho ("barrier", gfc_match_omp_barrier, ST_OMP_BARRIER); > @@ -1672,9 +1673,9 @@ next_statement (void) > case ST_OMP_CANCEL: case ST_OMP_CANCELLATION_POINT: case ST_OMP_DEPOBJ: \ > case ST_OMP_TARGET_UPDATE: case ST_OMP_TARGET_ENTER_DATA: \ > case ST_OMP_TARGET_EXIT_DATA: case ST_OMP_ORDERED_DEPEND: case ST_OMP_ERROR: \ > - case ST_ERROR_STOP: case ST_OMP_SCAN: case ST_SYNC_ALL: \ > - case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: case ST_UNLOCK: \ > - case ST_FORM_TEAM: case ST_CHANGE_TEAM: \ > + case ST_OMP_ALLOCATE: case ST_ERROR_STOP: case ST_OMP_SCAN: \ > + case ST_SYNC_ALL: case ST_SYNC_IMAGES: case ST_SYNC_MEMORY: case ST_LOCK: \ > + case ST_UNLOCK: case ST_FORM_TEAM: case ST_CHANGE_TEAM: \ > case ST_END_TEAM: case ST_SYNC_TEAM: \ > case ST_EVENT_POST: case ST_EVENT_WAIT: case ST_FAIL_IMAGE: \ > case ST_OACC_UPDATE: case ST_OACC_WAIT: case ST_OACC_CACHE: \ > @@ -2351,6 +2352,9 @@ gfc_ascii_statement (gfc_statement st) > case ST_OACC_END_ATOMIC: > p = "!$ACC END ATOMIC"; > break; > + case ST_OMP_ALLOCATE: > + p = "!$OMP ALLOCATE"; > + break; > case ST_OMP_ATOMIC: > p = "!$OMP ATOMIC"; > break; > diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c > index 43eeefee07f..991cd4fe874 100644 > --- a/gcc/fortran/resolve.c > +++ b/gcc/fortran/resolve.c > @@ -12306,6 +12306,7 @@ start: > gfc_resolve_oacc_directive (code, ns); > break; > > + case EXEC_OMP_ALLOCATE: > case EXEC_OMP_ATOMIC: > case EXEC_OMP_BARRIER: > case EXEC_OMP_CANCEL: > diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c > index 73f30c2137f..7b282e96c3d 100644 > --- a/gcc/fortran/st.c > +++ b/gcc/fortran/st.c > @@ -214,6 +214,7 @@ gfc_free_statement (gfc_code *p) > case EXEC_OACC_ENTER_DATA: > case EXEC_OACC_EXIT_DATA: > case EXEC_OACC_ROUTINE: > + case EXEC_OMP_ALLOCATE: > case EXEC_OMP_ATOMIC: > case EXEC_OMP_CANCEL: > case EXEC_OMP_CANCELLATION_POINT: > diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c > index 26f0815b5ea..a2248c83623 100644 > --- a/gcc/fortran/trans.c > +++ b/gcc/fortran/trans.c > @@ -2140,6 +2140,7 @@ trans_code (gfc_code * code, tree cond) > res = gfc_trans_dt_end (code); > break; > > + case EXEC_OMP_ALLOCATE: > case EXEC_OMP_ATOMIC: > case EXEC_OMP_BARRIER: > case EXEC_OMP_CANCEL: > diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 > new file mode 100644 > index 00000000000..3f512d66495 > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 > @@ -0,0 +1,112 @@ > +! { dg-do compile } > + > +module test > + integer, allocatable :: mvar1 > + integer, allocatable :: mvar2 > + integer, allocatable :: mvar3 > +end module > + > +subroutine foo(x, y) > + use omp_lib > + implicit none > + integer :: x > + integer :: y > + > + integer, allocatable :: var1(:) > + integer, allocatable :: var2(:) > + integer, allocatable :: var3(:) > + integer, allocatable :: var4(:) > + integer, allocatable :: var5(:) > + integer, allocatable :: var6(:) > + integer, allocatable :: var7(:) > + integer, allocatable :: var8(:) > + integer, allocatable :: var9(:) > + > + !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } > + allocate (var1(x)) > + > + !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } > + allocate (var3(x)) > + > + !$omp allocate (x) ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." } > + x = 2 > + > + !$omp allocate (var4) ! { dg-error "'var4' with ALLOCATABLE attribute is not allowed in 'allocate' directive at .1. as this directive is not associated with an 'allocate' statement." } > + ! { dg-message "sorry, unimplemented: 'allocate' directive that is not associated with an 'allocate' statement is not supported." "" { target *-*-* } .-1 } > + y = 2 > + > + !$omp allocate (var5) > + !$omp allocate ! { dg-error "Empty variable list is not allowed at .1. when multiple 'allocate' directives are associated with an 'allocate' statement." } > + allocate (var5(x)) > + > + !$omp allocate (var6) > + !$omp allocate (var7) ! { dg-error "'var7' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } > + !$omp allocate (var8) ! { dg-error "'var8' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } > + allocate (var6(x)) > + > + !$omp allocate (var9) > + !$omp allocate (var9) ! { dg-error "'var9' is used in multiple 'allocate' directives at .1." } > + allocate (var9(x)) > + > +end subroutine > + > +function outer(a) > + IMPLICIT NONE > + > + integer :: outer, a > + integer, allocatable :: var1 > + > + outer = inner(a) + 5 > + return > + > + contains > + > + integer function inner(x) > + integer :: x > + integer, allocatable :: var2 > + > + !$omp allocate (var1, var2) ! { dg-error "'var1' is not in the same scope as 'allocate' directive at .1." } > + allocate (var1, var2) > + > + inner = x + 10 > + return > + end function inner > + > +end function outer > + > +subroutine bar(s) > + use omp_lib > + use test > + integer :: s > + integer, save, allocatable :: svar1 > + integer, save, allocatable :: svar2 > + integer, save, allocatable :: svar3 > + > + type (omp_alloctrait) :: traits(3) > + integer (omp_allocator_handle_kind) :: a > + > + traits = [omp_alloctrait (omp_atk_alignment, 64), & > + omp_alloctrait (omp_atk_fallback, omp_atv_null_fb), & > + omp_alloctrait (omp_atk_pool_size, 8192)] > + a = omp_init_allocator (omp_default_mem_space, 3, traits) > + if (a == omp_null_allocator) stop 1 > + > + !$omp allocate (mvar1) allocator(a) ! { dg-error "'mvar1' should use predefined allocator at .1." } > + allocate (mvar1) > + > + !$omp allocate (mvar2) ! { dg-error "'mvar2' should use predefined allocator at .1." } > + allocate (mvar2) > + > + !$omp allocate (mvar3) allocator(omp_low_lat_mem_alloc) > + allocate (mvar3) > + > + !$omp allocate (svar1) allocator(a) ! { dg-error "'svar1' should use predefined allocator at .1." } > + allocate (svar1) > + > + !$omp allocate (svar2) ! { dg-error "'svar2' should use predefined allocator at .1." } > + allocate (svar2) > + > + !$omp allocate (svar3) allocator(omp_low_lat_mem_alloc) > + allocate (svar3) > +end subroutine > + > diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 > new file mode 100644 > index 00000000000..761b6dede28 > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-5.f90 > @@ -0,0 +1,73 @@ > +! { dg-do compile } > + > +module omp_lib_kinds > + use iso_c_binding, only: c_int, c_intptr_t > + implicit none > + private :: c_int, c_intptr_t > + integer, parameter :: omp_allocator_handle_kind = c_intptr_t > + > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_null_allocator = 0 > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_default_mem_alloc = 1 > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_large_cap_mem_alloc = 2 > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_const_mem_alloc = 3 > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_high_bw_mem_alloc = 4 > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_low_lat_mem_alloc = 5 > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_cgroup_mem_alloc = 6 > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_pteam_mem_alloc = 7 > + integer (kind=omp_allocator_handle_kind), & > + parameter :: omp_thread_mem_alloc = 8 > +end module > + > +subroutine foo(x, y) > + use omp_lib_kinds > + implicit none > + integer :: x > + integer :: y > + > + integer, allocatable :: var1(:) > + integer, allocatable :: var2(:) > + integer, allocatable :: var3(:) > + integer, allocatable :: var4(:,:) > + integer, allocatable :: var5(:) > + integer, allocatable :: var6(:) > + integer, allocatable :: var7(:) > + integer, allocatable :: var8(:) > + integer, allocatable :: var9(:) > + integer, allocatable :: var10(:) > + integer, allocatable :: var11(:) > + integer, allocatable :: var12(:) > + > + !$omp allocate (var1) allocator(omp_default_mem_alloc) > + allocate (var1(x)) > + > + !$omp allocate (var2) > + allocate (var2(x)) > + > + !$omp allocate (var3, var4) allocator(omp_large_cap_mem_alloc) > + allocate (var3(x),var4(x,y)) > + > + !$omp allocate() > + allocate (var5(x)) > + > + !$omp allocate > + allocate (var6(x)) > + > + !$omp allocate () allocator(omp_default_mem_alloc) > + allocate (var7(x)) > + > + !$omp allocate allocator(omp_default_mem_alloc) > + allocate (var8(x)) > + > + !$omp allocate (var9) allocator(omp_default_mem_alloc) > + !$omp allocate (var10) allocator(omp_large_cap_mem_alloc) > + allocate (var9(x), var10(x)) > + > +end subroutine ----------------- Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht München, HRB 106955 From e07fb2a36377a6504dda088f0a1c5185ff51d652 Mon Sep 17 00:00:00 2001 From: Thomas Schwinge Date: Wed, 1 Feb 2023 12:30:28 +0100 Subject: [PATCH] Fix 'omp_allocator_handle_kind' example in 'gfortran.dg/gomp/allocate-4.f90' MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit I've noticed that while 'gfortran.dg/gomp/allocate-4.f90' is all-PASS for x86_64-pc-linux-gnu (default) '-m64' testing, it does have one FAIL for '-m32' testing: 'test for errors, line 25'. Here's the 'diff': @@ -1,8 +1,3 @@ -source-gcc/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:25:34: - - 25 | !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } - | 1 -Error: Expected integer expression of the ‘omp_allocator_handle_kind’ kind at (1) source-gcc/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90:28:130: 28 | !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } I understand that's due to an "accidental" non-match vs. match of '10' vs. 'omp_allocator_handle_kind' ('c_intptr_t') data types: > --- a/gcc/fortran/openmp.c > +++ b/gcc/fortran/openmp.c > +static void > +gfc_resolve_omp_allocate (gfc_code *code, gfc_namespace *ns) > +{ > + gfc_alloc *al; > + gfc_omp_namelist *n = NULL; > + gfc_omp_namelist *cn = NULL; > + gfc_omp_namelist *p, *tail; > + gfc_code *cur; > + hash_set vars; > + > + gfc_omp_clauses *clauses = code->ext.omp_clauses; > + gcc_assert (clauses); > + cn = clauses->lists[OMP_LIST_ALLOCATOR]; > + gfc_expr *omp_al = cn ? cn->expr : NULL; > + > + if (omp_al && (omp_al->ts.type != BT_INTEGER > + || omp_al->ts.kind != gfc_c_intptr_kind)) > + gfc_error ("Expected integer expression of the " > + "% kind at %L", &omp_al->where); $ git grep -i parameter.\*omp_allocator_handle_kind -- libgomp/omp_lib.* libgomp/omp_lib.f90.in: integer, parameter :: omp_allocator_handle_kind = c_intptr_t libgomp/omp_lib.h.in: parameter (omp_allocator_handle_kind = @INTPTR_T_KIND@) Fix-up for og12 commit 491478d12b83e102f72858e8a871a25c951df293 "Add parsing support for allocate directive (OpenMP 5.0)". gcc/testsuite/ * gfortran.dg/gomp/allocate-4.f90: Fix 'omp_allocator_handle_kind' example. --- gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 index 3f512d66495..c9b9c3f6c1d 100644 --- a/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/allocate-4.f90 @@ -22,7 +22,12 @@ subroutine foo(x, y) integer, allocatable :: var8(:) integer, allocatable :: var9(:) - !$omp allocate (var1) allocator(10) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } + ! Don't do this (..., but it does pass the checks). + !$omp allocate (var1) allocator(10_omp_allocator_handle_kind) ! { dg-bogus "Expected integer expression of the 'omp_allocator_handle_kind' kind" } + allocate (var1(x)) + + ! Assumtion is that 'omp_allocator_handle_kind' ('c_intptr_t') isn't 1. + !$omp allocate (var1) allocator(10_1) ! { dg-error "Expected integer expression of the 'omp_allocator_handle_kind' kind at .1." } allocate (var1(x)) !$omp allocate (var2) ! { dg-error "'var2' in 'allocate' directive at .1. is not present in associated 'allocate' statement." } -- 2.25.1