From patchwork Thu Aug 10 13:33:05 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Julian Brown X-Patchwork-Id: 1819856 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces+incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Received: from server2.sourceware.org (ip-8-43-85-97.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (P-384) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4RM7FS0w2wz1yYC for ; Thu, 10 Aug 2023 23:34:36 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 0836B388459F for ; Thu, 10 Aug 2023 13:34:24 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from esa3.mentor.iphmx.com (esa3.mentor.iphmx.com [68.232.137.180]) by sourceware.org (Postfix) with ESMTPS id C28B33855586; Thu, 10 Aug 2023 13:33:34 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org C28B33855586 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="6.01,162,1684828800"; d="scan'208";a="14111564" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 10 Aug 2023 05:33:34 -0800 IronPort-SDR: ehdZlECWTn4ysks+VP8cvMuLnO11zYhT0DInmoxb4XeNoV6DvJfhNsrVvaO4lunY39mqasBveP HuAnrjCaQzT21MfkI/k+i6M8dgLxRhYWtbobqhzBUF8rDijRcnGir/MgzLamIwghzAzjYuHs/V LTddT564wUBGq3gGw3wNOSh7nQM+Kw9ElAkBYh46h59JVrSCZ0fRS4Z8TJSOqVVouyZckDJe12 Z5O41/lqDzDiYVoFl4WWZqDZ5i/6lptrrqaJX/ExhJUCLY1L/SXa9MLieYgzBDXYSgCwRooP9O ou8= From: Julian Brown To: CC: , , Subject: [PATCH 4/5] OpenMP: Look up 'declare mapper' definitions at resolution time not parse time Date: Thu, 10 Aug 2023 13:33:05 +0000 Message-ID: X-Mailer: git-send-email 2.25.1 In-Reply-To: References: MIME-Version: 1.0 X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-14.mgc.mentorg.com (139.181.222.14) To svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) X-Spam-Status: No, score=-11.8 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, 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+incoming=patchwork.ozlabs.org@gcc.gnu.org Sender: "Gcc-patches" This patch moves 'declare mapper' lookup for OpenMP clauses from parse time to resolution time for Fortran, and adds diagnostics for missing named mappers. This changes clause lookup in a particular case -- where several 'declare mapper's are defined in a context, mappers declared earlier may now instantiate mappers declared later, whereas previously they would not. I think the new behaviour makes more sense -- at an invocation site, all mappers are visible no matter the declaration order in some particular block. I've adjusted tests to account for this. I think the new arrangement better matches the Fortran FE's usual way of doing things -- mapper lookup is a semantic concept, not a syntactical one, so shouldn't be handled in the syntax-handling code. The patch also fixes a case where the user explicitly writes 'default' as the name on the mapper modifier for a clause. 2023-08-10 Julian Brown gcc/fortran/ * gfortran.h (gfc_omp_namelist_udm): Add MAPPER_ID field to store the mapper name to use for lookup during resolution. * match.cc (gfc_free_omp_namelist): Handle OMP_LIST_TO and OMP_LIST_FROM when freeing mapper references. * module.cc (load_omp_udms, write_omp_udm): Handle MAPPER_ID field. * openmp.cc (gfc_match_omp_clauses): Handle explicitly-specified 'default' name. Don't do mapper lookup here, but record mapper name if the user specifies one. (resolve_omp_clauses): Do mapper lookup here instead. Report error for missing named mapper. gcc/testsuite/ * gfortran.dg/gomp/declare-mapper-31.f90: New test. libgomp/ * testsuite/libgomp.fortran/declare-mapper-30.f90: New test. * testsuite/libgomp.fortran/declare-mapper-4.f90: Adjust test for new lookup behaviour. --- gcc/fortran/gfortran.h | 3 ++ gcc/fortran/match.cc | 4 +- gcc/fortran/module.cc | 6 +++ gcc/fortran/openmp.cc | 46 ++++++++++++++----- .../gfortran.dg/gomp/declare-mapper-31.f90 | 34 ++++++++++++++ .../libgomp.fortran/declare-mapper-30.f90 | 24 ++++++++++ .../libgomp.fortran/declare-mapper-4.f90 | 18 +++++--- 7 files changed, 116 insertions(+), 19 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 create mode 100644 libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index a98424b3263..3b854e14d47 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1784,6 +1784,9 @@ gfc_omp_udm; typedef struct gfc_omp_namelist_udm { + /* Used to store mapper_id before resolution. */ + const char *mapper_id; + bool multiple_elems_p; struct gfc_omp_udm *udm; } diff --git a/gcc/fortran/match.cc b/gcc/fortran/match.cc index 53367ab2a0b..3db8e0f0969 100644 --- a/gcc/fortran/match.cc +++ b/gcc/fortran/match.cc @@ -5537,7 +5537,9 @@ void gfc_free_omp_namelist (gfc_omp_namelist *name, int list) { bool free_ns = (list == OMP_LIST_AFFINITY || list == OMP_LIST_DEPEND); - bool free_mapper = (list == OMP_LIST_MAP); + bool free_mapper = (list == OMP_LIST_MAP + || list == OMP_LIST_TO + || list == OMP_LIST_FROM); bool free_align = (list == OMP_LIST_ALLOCATE); gfc_omp_namelist *n; diff --git a/gcc/fortran/module.cc b/gcc/fortran/module.cc index 5cd52e7729b..acdbfa7924f 100644 --- a/gcc/fortran/module.cc +++ b/gcc/fortran/module.cc @@ -5238,6 +5238,11 @@ load_omp_udms (void) if (peek_atom () != ATOM_RPAREN) { n->u2.udm = gfc_get_omp_namelist_udm (); + mio_pool_string (&n->u2.udm->mapper_id); + + if (n->u2.udm->mapper_id == NULL) + n->u2.udm->mapper_id = gfc_get_string ("%s", ""); + n->u2.udm->multiple_elems_p = mio_name (0, omp_map_cardinality); mio_pointer_ref (&n->u2.udm->udm); } @@ -6314,6 +6319,7 @@ write_omp_udm (gfc_omp_udm *udm) if (n->u2.udm) { + mio_pool_string (&n->u2.udm->mapper_id); mio_name (n->u2.udm->multiple_elems_p, omp_map_cardinality); mio_pointer_ref (&n->u2.udm->udm); } diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 0109df4dfce..ba2a8221b96 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -3615,6 +3615,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, m = gfc_match (" %n ) ", mapper_id); if (m != MATCH_YES) goto error; + if (strcmp (mapper_id, "default") == 0) + mapper_id[0] = '\0'; } else break; @@ -3689,19 +3691,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, for (n = *head; n; n = n->next) { n->u.map_op = map_op; - - gfc_typespec *ts; - if (n->expr) - ts = &n->expr->ts; - else - ts = &n->sym->ts; - - gfc_omp_udm *udm - = gfc_find_omp_udm (gfc_current_ns, mapper_id, ts); - if (udm) + if (mapper_id[0] != '\0') { n->u2.udm = gfc_get_omp_namelist_udm (); - n->u2.udm->udm = udm; + n->u2.udm->mapper_id + = gfc_get_string ("%s", mapper_id); } } continue; @@ -9155,6 +9149,36 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, if (!omp_verify_map_motion_clauses (code, list, name, n, openacc)) break; + if (list == OMP_LIST_MAP + || list == OMP_LIST_TO + || list == OMP_LIST_FROM) + { + gfc_typespec *ts; + + if (n->expr) + ts = &n->expr->ts; + else + ts = &n->sym->ts; + + const char *mapper_id + = n->u2.udm ? n->u2.udm->mapper_id : ""; + + gfc_omp_udm *udm = gfc_find_omp_udm (gfc_current_ns, + mapper_id, ts); + if (mapper_id[0] != '\0' && !udm) + gfc_error ("User-defined mapper %qs not found at %L", + mapper_id, &n->where); + else if (udm) + { + if (!n->u2.udm) + { + n->u2.udm = gfc_get_omp_namelist_udm (); + gcc_assert (mapper_id[0] == '\0'); + n->u2.udm->mapper_id = mapper_id; + } + n->u2.udm->udm = udm; + } + } } if (list != OMP_LIST_DEPEND) diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 new file mode 100644 index 00000000000..bcb0a6c5429 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/declare-mapper-31.f90 @@ -0,0 +1,34 @@ +! { dg-do run } + +type t +integer :: x, y +integer, allocatable :: arr(:) +end type t + +type(t) :: var + +allocate(var%arr(1:20)) + +var%arr = 0 + +! If we ask for a named mapper that hasn't been defined, an error should be +! raised. This isn't a *syntax* error, so the !$omp target..!$omp end target +! block should still be parsed correctly. +!$omp target map(mapper(arraymapper), tofrom: var) +! { dg-error "User-defined mapper .arraymapper. not found" "" { target *-*-* } .-1 } +var%arr(5) = 5 +!$omp end target + +! OTOH, this is a syntax error, and the offload block is not recognized. +!$omp target map( +! { dg-error "Syntax error in OpenMP variable list" "" { target *-*-* } .-1 } +var%arr(6) = 6 +!$omp end target +! { dg-error "Unexpected !.OMP END TARGET statement" "" { target *-*-* } .-1 } + +! ...but not for the specific name 'default'. +!$omp target map(mapper(default), tofrom: var) +var%arr(5) = 5 +!$omp end target + +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 new file mode 100644 index 00000000000..bfac28cd45c --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-30.f90 @@ -0,0 +1,24 @@ +! { dg-do run } + +type t +integer :: x, y +integer, allocatable :: arr(:) +end type t + +!$omp declare mapper (t :: x) map(x%arr) + +type(t) :: var + +allocate(var%arr(1:20)) + +var%arr = 0 + +! The mapper named literally 'default' should be the default mapper, i.e. +! the same as the unnamed mapper defined above. +!$omp target map(mapper(default), tofrom: var) +var%arr(5) = 5 +!$omp end target + +if (var%arr(5).ne.5) stop 1 + +end diff --git a/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 index e95dbbd6f96..266845f35c7 100644 --- a/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 +++ b/libgomp/testsuite/libgomp.fortran/declare-mapper-4.f90 @@ -3,7 +3,7 @@ program myprog type s integer :: c - integer :: d(99) + integer, allocatable :: d(:) end type s type t @@ -16,21 +16,25 @@ end type u type(u) :: myu -! Here, the mappers are declared out of order, so later ones are not 'seen' by -! earlier ones. Is that right? +! Here, the mappers are declared out of order, but earlier ones can still +! trigger mappers defined later. Implementation-wise, this happens during +! resolution, but from the user perspective it appears to happen at +! instantiation time -- at which point all mappers are visible. I think +! that makes sense. !$omp declare mapper (u :: x) map(tofrom: x%myt) !$omp declare mapper (t :: x) map(tofrom: x%mys) !$omp declare mapper (s :: x) map(tofrom: x%c, x%d(1:x%c)) +allocate(myu%myt%mys%d(1:20)) + myu%myt%mys%c = 1 myu%myt%mys%d = 0 !$omp target map(tofrom: myu) -myu%myt%mys%d(5) = myu%myt%mys%d(5) + 1 +myu%myt%mys%d(1) = myu%myt%mys%d(1) + 1 !$omp end target -! Note: we used the default mapper, not the 's' mapper, so we mapped the -! whole array 'd'. -if (myu%myt%mys%d(5).ne.1) stop 1 +! Note: we only mapped the first element of the array 'd'. +if (myu%myt%mys%d(1).ne.1) stop 1 end program myprog