From patchwork Tue Oct 12 08:41:28 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 46123 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 B29DD3858402 for ; Tue, 12 Oct 2021 08:41:53 +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 41C593858D3C for ; Tue, 12 Oct 2021 08:41:36 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 41C593858D3C Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: 8wybX9tX5Rk0HuMllQbQRi16DcTw3tJLeQVX2GwsJK+AXSd9qwtHUuLZ8jjAhaYsjmZxvThPDz Ig38ZrqvbEB4zPiTWuz8fhFygYf66yu0IqQ6yITWCtlO/MYt6cZ+D9I4Nf9zekYv07woEPdwd2 x28PX0Zuef17BCGUg/RWjXYZPLLcNcURRxbiiVHkMMI3yrtoLPuh05kSeaKuRBtcsQadbw926u XTRN5L0MZhIX8XhBikKUgPrNDUZdOv+P599wVhBAC6K6gw8zn++JiDc9zG2w5/QhQT6gto7aBs yGuETY6C113FcclJMJJEtOyB X-IronPort-AV: E=Sophos;i="5.85,367,1624348800"; d="diff'?scan'208";a="67067429" Received: from orw-gwy-02-in.mentorg.com ([192.94.38.167]) by esa2.mentor.iphmx.com with ESMTP; 12 Oct 2021 00:41:34 -0800 IronPort-SDR: wqn4T/r+UIO48vUiw2StElUzuZPtz3YlvaY43v2nFGTOAVCL2BCBs/7vCicLNiG02XJZspJnrh lpFYQT+wEBb3iWqsIb6oxoufyZvKBZjJyyN4Cr+aYBZprLMg+bb2r0Xr8tk0uH+QmzrKaNuc/8 S6YuRJZUc2cp/uC2xgnd2i3mrhE9TSF0+kdQnS8qfUC/ZcgkERdxJVp41794GS2HuRrDYT0bhB YuqkazOPzEpNnHZ/tVexel80amC2C3bmEY02wbgfE6loV/xZUAXXT9+a61vbGyaA5y4lp+iDh7 M6Y= Message-ID: Date: Tue, 12 Oct 2021 10:41:28 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:91.0) Gecko/20100101 Thunderbird/91.2.0 Subject: [Patch] Fortran version of libgomp.c-c++-common/icv-{3,4}.c (was: [committed] openmp: Add testsuite coverage for omp_{get_max,set_num}_threads and omp_{s,g}et_teams_thread_limit) Content-Language: en-US To: Jakub Jelinek , References: <20211012074253.GY304296@tucnak> From: Tobias Burnus In-Reply-To: <20211012074253.GY304296@tucnak> X-Originating-IP: [137.202.0.90] X-ClientProxiedBy: svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) To svr-ies-mbx-01.mgc.mentorg.com (139.181.222.1) X-Spam-Status: No, score=-11.6 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.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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: , Cc: Tobias Burnus Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Hi, On 12.10.21 09:42, Jakub Jelinek wrote: > This adds (C/C++ only) testsuite coverage for these new OpenMP 5.1 APIs. And attached is the Fortranified version of those testcases. OK? Tobias ----------------- 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 Fortran version of libgomp.c-c++-common/icv-{3,4}.c This adds the Fortran testsuite coverage of omp_{get_max,set_num}_threads and omp_{s,g}et_teams_thread_limit libgomp/ * testsuite/libgomp.fortran/icv-3.f90: New. * testsuite/libgomp.fortran/icv-4.f90: New. libgomp/testsuite/libgomp.fortran/icv-3.f90 | 60 +++++++++++++++++++++++++++++ libgomp/testsuite/libgomp.fortran/icv-4.f90 | 45 ++++++++++++++++++++++ 2 files changed, 105 insertions(+) diff --git a/libgomp/testsuite/libgomp.fortran/icv-3.f90 b/libgomp/testsuite/libgomp.fortran/icv-3.f90 new file mode 100644 index 00000000000..b2ccd776223 --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/icv-3.f90 @@ -0,0 +1,60 @@ +use omp_lib +implicit none (type, external) + if (.not. env_exists ("OMP_NUM_TEAMS") & + .and. omp_get_max_teams () /= 0) & + error stop 1 + call omp_set_num_teams (7) + if (omp_get_max_teams () /= 7) & + error stop 2 + if (.not. env_exists ("OMP_TEAMS_THREAD_LIMIT") & + .and. omp_get_teams_thread_limit () /= 0) & + error stop 3 + call omp_set_teams_thread_limit (15) + if (omp_get_teams_thread_limit () /= 15) & + error stop 4 + !$omp teams + if (omp_get_max_teams () /= 7 & + .or. omp_get_teams_thread_limit () /= 15 & + .or. omp_get_num_teams () < 1 & + .or. omp_get_num_teams () > 7 & + .or. omp_get_team_num () < 0 & + .or. omp_get_team_num () >= omp_get_num_teams () & + .or. omp_get_thread_limit () < 1 & + .or. omp_get_thread_limit () > 15) & + error stop 5 + !$omp end teams + !$omp teams num_teams(5) thread_limit (13) + if (omp_get_max_teams () /= 7 & + .or. omp_get_teams_thread_limit () /= 15 & + .or. omp_get_num_teams () /= 5 & + .or. omp_get_team_num () < 0 & + .or. omp_get_team_num () >= omp_get_num_teams () & + .or. omp_get_thread_limit () < 1 & + .or. omp_get_thread_limit () > 13) & + error stop 6 + !$omp end teams + !$omp teams num_teams(8) thread_limit (16) + if (omp_get_max_teams () /= 7 & + .or. omp_get_teams_thread_limit () /= 15 & + .or. omp_get_num_teams () /= 8 & + .or. omp_get_team_num () < 0 & + .or. omp_get_team_num () >= omp_get_num_teams () & + .or. omp_get_thread_limit () < 1 & + .or. omp_get_thread_limit () > 16) & + error stop 7 + !$omp end teams +contains + logical function env_exists (name) + character(len=*) :: name + character(len=40) :: val + integer :: stat + call get_environment_variable (name, val, status=stat) + if (stat == 0) then + env_exists = .true. + else if (stat == 1) then + env_exists = .false. + else + error stop 10 + endif + end +end diff --git a/libgomp/testsuite/libgomp.fortran/icv-4.f90 b/libgomp/testsuite/libgomp.fortran/icv-4.f90 new file mode 100644 index 00000000000..f76c96d7d0d --- /dev/null +++ b/libgomp/testsuite/libgomp.fortran/icv-4.f90 @@ -0,0 +1,45 @@ +! { dg-set-target-env-var OMP_NUM_TEAMS "6" } +! { dg-set-target-env-var OMP_TEAMS_THREAD_LIMIT "12" } + +use omp_lib +implicit none (type, external) + if (env_is_set ("OMP_NUM_TEAMS", "6")) then + if (omp_get_max_teams () /= 6) & + error stop 1 + else + call omp_set_num_teams (6) + end if + if (env_is_set ("OMP_TEAMS_THREAD_LIMIT", "12")) then + if (omp_get_teams_thread_limit () /= 12) & + error stop 2 + else + call omp_set_teams_thread_limit (12) + end if + !$omp teams + if (omp_get_max_teams () /= 6 & + .or. omp_get_teams_thread_limit () /= 12 & + .or. omp_get_num_teams () < 1 & + .or. omp_get_num_teams () > 6 & + .or. omp_get_team_num () < 0 & + .or. omp_get_team_num () >= omp_get_num_teams () & + .or. omp_get_thread_limit () < 1 & + .or. omp_get_thread_limit () > 12) & + error stop 3 + !$omp end teams +contains + logical function env_is_set (name, val) + character(len=*) :: name, val + character(len=40) :: val2 + integer :: stat + call get_environment_variable (name, val2, status=stat) + if (stat == 0) then + if (val == val2) then + env_is_set = .true. + return + end if + else if (stat /= 1) then + error stop 10 + endif + env_is_set = .false. + end +end