From patchwork Mon Jul 24 19:43:10 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 1812054 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 4R8rFM1SHbz1yZw for ; Tue, 25 Jul 2023 05:43:51 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 55BC53857722 for ; Mon, 24 Jul 2023 19:43:48 +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 1CB843858C5F; Mon, 24 Jul 2023 19:43:22 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 1CB843858C5F 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,228,1684828800"; d="diff'?scan'208";a="12606020" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa3.mentor.iphmx.com with ESMTP; 24 Jul 2023 11:43:15 -0800 IronPort-SDR: sXU1SUefY4lU5/uuQWgn+ZhgwrAGwZNNiEHM+HnuWpoWUFAjswEq9UIdEvjykQfmVWx/Z06XwG W3AroyhEufLqNZu9lZqyX3UwBUkv5mzYPgw7JgAyyVwpr+UYdIRGme/obHee6G+78799nblFH7 CF43De/XKvfRlOXCneiR1OCqiagKh1Hh/VkQWtuvamCj8xiXL2MV1RrcRqZlybiIESL3+lzSV5 1oEOOru3J/8cqlktS6RzaSlWpCIM1M+RCbuwXP630GKOljKq2WmFhpxlH4sRJR9kDV/8DOx8K5 e9Q= Message-ID: Date: Mon, 24 Jul 2023 21:43:10 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.13.0 Content-Language: en-US To: gcc-patches , fortran From: Tobias Burnus Subject: [Patch] OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065] CC: Jakub Jelinek X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-11.mgc.mentorg.com (139.181.222.11) To svr-ies-mbx-12.mgc.mentorg.com (139.181.222.12) X-Spam-Status: No, score=-10.6 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE, URIBL_BLACK 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 adds diagnostic for additional code alongside a nested teams in a target region. The diagnostic is happening soon after parsing such that expressions in clauses are not yet expanded - those would end up before TEAMS and can be very complicated (e.g. assume an allocatable-returning function). (The patch diagnoses it in openmp.cc; after trans-openmp.cc it would already be to late.) Comments, remarks, suggestions? Tobias PS: Something similar is also needed for C/C++ but there templates and lambda functions might make it harder to implement. In any case, it has to be done in the FE. Tracked at PR71065 ----------------- 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 OpenMP/Fortran: Reject not strictly nested target -> teams [PR110725, PR71065] OpenMP requires: "If a teams region is nested inside a target region, the corresponding target construct must not contain any statements, declarations or directives outside of the corresponding teams construct." Test for it! PR fortran/110725 PR middle-end/71065 gcc/fortran/ChangeLog: * gfortran.h (gfc_omp_clauses): Add contains_teams_construct. * openmp.cc (resolve_omp_target): New; check for teams nesting. (gfc_resolve_omp_directive): Call it. * parse.cc (decode_omp_directive): Set contains_teams_construct on enclosing ST_OMP_TARGET. gcc/testsuite/ChangeLog: * gfortran.dg/gomp/pr99226.f90: Update dg-error. * gfortran.dg/gomp/teams-5.f90: New test. gcc/fortran/gfortran.h | 1 + gcc/fortran/openmp.cc | 39 ++++++++- gcc/fortran/parse.cc | 33 ++++++++ gcc/testsuite/gfortran.dg/gomp/pr99226.f90 | 2 +- gcc/testsuite/gfortran.dg/gomp/teams-5.f90 | 127 +++++++++++++++++++++++++++++ 5 files changed, 200 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 6482a885211..577ef807af7 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1575,6 +1575,7 @@ typedef struct gfc_omp_clauses unsigned order_unconstrained:1, order_reproducible:1, capture:1; unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1; unsigned non_rectangular:1, order_concurrent:1; + unsigned contains_teams_construct:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index 05a697da071..675011a18ce 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -10653,6 +10653,41 @@ gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) } +static void +resolve_omp_target (gfc_code *code) +{ +#define GFC_IS_TEAMS_CONSTRUCT(op) \ + (op == EXEC_OMP_TEAMS \ + || op == EXEC_OMP_TEAMS_DISTRIBUTE \ + || op == EXEC_OMP_TEAMS_DISTRIBUTE_SIMD \ + || op == EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO \ + || op == EXEC_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD \ + || op == EXEC_OMP_TEAMS_LOOP) + + if (!code->ext.omp_clauses->contains_teams_construct) + return; + if ((GFC_IS_TEAMS_CONSTRUCT (code->block->next->op) + && code->block->next->next == NULL) + || (code->block->next->op == EXEC_BLOCK + && code->block->next->next + && GFC_IS_TEAMS_CONSTRUCT (code->block->next->next->op) + && code->block->next->next->next == NULL)) + return; + gfc_code *c = code->block->next; + while (c && !GFC_IS_TEAMS_CONSTRUCT (c->op)) + c = c->next; + if (c) + gfc_error ("!$OMP TARGET region at %L with a nested TEAMS at %L may not " + "contain any other statement, declaration or directive outside " + "of the single TEAMS construct", &c->loc, &code->loc); + else + gfc_error ("!$OMP TARGET region at %L with a nested TEAMS may not " + "contain any other statement, declaration or directive outside " + "of the single TEAMS construct", &code->loc); +#undef GFC_IS_TEAMS_CONSTRUCT +} + + /* Resolve OpenMP directive clauses and check various requirements of each directive. */ @@ -10703,6 +10738,9 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_TEAMS_LOOP: resolve_omp_do (code); break; + case EXEC_OMP_TARGET: + resolve_omp_target (code); + gcc_fallthrough (); case EXEC_OMP_ALLOCATE: case EXEC_OMP_ALLOCATORS: case EXEC_OMP_ASSUME: @@ -10718,7 +10756,6 @@ gfc_resolve_omp_directive (gfc_code *code, gfc_namespace *ns) case EXEC_OMP_SCOPE: case EXEC_OMP_SECTIONS: case EXEC_OMP_SINGLE: - case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_DATA: case EXEC_OMP_TARGET_ENTER_DATA: case EXEC_OMP_TARGET_EXIT_DATA: diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index e53b7a42e92..011a39c3d04 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -1312,6 +1312,39 @@ decode_omp_directive (void) prog_unit->omp_target_seen = true; break; } + case ST_OMP_TEAMS: + case ST_OMP_TEAMS_DISTRIBUTE: + case ST_OMP_TEAMS_DISTRIBUTE_SIMD: + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO: + case ST_OMP_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case ST_OMP_TEAMS_LOOP: + if (gfc_state_stack->previous && gfc_state_stack->previous->tail) + { + gfc_state_data *stk = gfc_state_stack; + do { + stk = stk->previous; + } while (stk && stk->tail && stk->tail->op == EXEC_BLOCK); + if (stk && stk->tail) + switch (stk->tail->op) + { + case EXEC_OMP_TARGET: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_SIMD: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: + case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_TEAMS_LOOP: + case EXEC_OMP_TARGET_PARALLEL: + case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_DO_SIMD: + case EXEC_OMP_TARGET_PARALLEL_LOOP: + case EXEC_OMP_TARGET_SIMD: + stk->tail->ext.omp_clauses->contains_teams_construct = 1; + break; + default: + break; + } + } + break; case ST_OMP_ERROR: if (new_st.ext.omp_clauses->at != OMP_AT_EXECUTION) return ST_NONE; diff --git a/gcc/testsuite/gfortran.dg/gomp/pr99226.f90 b/gcc/testsuite/gfortran.dg/gomp/pr99226.f90 index 72dbdde2e28..2aea0c15585 100644 --- a/gcc/testsuite/gfortran.dg/gomp/pr99226.f90 +++ b/gcc/testsuite/gfortran.dg/gomp/pr99226.f90 @@ -2,7 +2,7 @@ subroutine sub (n) integer :: n, i - !$omp target ! { dg-error "construct with nested 'teams' construct contains directives outside of the 'teams' construct" } + !$omp target ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } !$omp teams distribute dist_schedule (static,n+4) do i = 1, 8 end do diff --git a/gcc/testsuite/gfortran.dg/gomp/teams-5.f90 b/gcc/testsuite/gfortran.dg/gomp/teams-5.f90 new file mode 100644 index 00000000000..bf5461b87c8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/teams-5.f90 @@ -0,0 +1,127 @@ +! { dg-do compile } + +! PR fortran/110725 +! PR middle-end/71065 + +implicit none +integer :: x +!$omp target device(1) + block + !$omp teams num_teams(f()) + !$omp end teams + end block +!!$omp end target + +!$omp target device(1) + !$omp teams num_teams(f()) + !$omp end teams +!$omp end target + +!$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + x = 5 + !$omp teams num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + !$omp end teams +!$omp end target + +!$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + !$omp teams num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + !$omp end teams + x = 5 +!$omp end target + +!$omp target ! { dg-error "OMP TARGET region at .1. with a nested TEAMS may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + block + block + !$omp teams num_teams(f()) + !$omp end teams + end block + end block +!$omp end target + +!$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + block + x = 5 + !$omp teams num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + !$omp end teams + end block +!$omp end target + +!$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + block + !$omp teams num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + !$omp end teams + x = 5 + end block +!$omp end target + +!$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + block + !$omp teams num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + !$omp end teams + x = 5 + end block +!$omp end target + +contains + +function f() + !$omp declare target + integer, allocatable :: f + f = 5 +end +end + +subroutine sub1 + implicit none + integer :: x,i + + !$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + block + !$omp teams distribute num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + do i = 1, 5 + end do + x = 7 + end block + !$omp end target + + !$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + block + !$omp teams loop num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + do i = 1, 5 + end do + x = 7 + end block + !$omp end target + + !$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + !$omp teams distribute simd num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + do i = 1, 5 + end do + x = 7 + !$omp end target + + !$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + !$omp teams distribute parallel do num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + do i = 1, 5 + end do + x = 7 + !$omp end target + + !$omp target device(1) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + block + x = 7 + !$omp teams distribute parallel do simd num_teams(f()) ! { dg-error "OMP TARGET region at .1. with a nested TEAMS at .2. may not contain any other statement, declaration or directive outside of the single TEAMS construct" } + do i = 1, 5 + end do + end block + !$omp end target + +contains + +function f() + !$omp declare target + integer, allocatable :: f + f = 5 +end + +end