From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1534) id 97DFA3858D3C; Tue, 12 Oct 2021 08:54:44 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 97DFA3858D3C MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Tobias Burnus To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-4347] Fortran version of libgomp.c-c++-common/icv-{3,4}.c X-Act-Checkin: gcc X-Git-Author: Tobias Burnus X-Git-Refname: refs/heads/master X-Git-Oldrev: eb92cd57a1ebe7cd7589bdbec34d9ae337752ead X-Git-Newrev: f5a538e1647ae67cf204c5c3b1bd9cca5224dfd1 Message-Id: <20211012085444.97DFA3858D3C@sourceware.org> Date: Tue, 12 Oct 2021 08:54:44 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 12 Oct 2021 08:54:44 -0000 https://gcc.gnu.org/g:f5a538e1647ae67cf204c5c3b1bd9cca5224dfd1 commit r12-4347-gf5a538e1647ae67cf204c5c3b1bd9cca5224dfd1 Author: Tobias Burnus Date: Tue Oct 12 10:54:18 2021 +0200 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. Diff: --- 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