diff options
author | Tobias Burnus <tobias@codesourcery.com> | 2021-10-12 10:54:18 +0200 |
---|---|---|
committer | Tobias Burnus <tobias@codesourcery.com> | 2021-10-12 10:54:18 +0200 |
commit | f5a538e1647ae67cf204c5c3b1bd9cca5224dfd1 (patch) | |
tree | 366f289c75d37d2e15bfb9c7d6d6fceaa699dc32 /libgomp | |
parent | eb92cd57a1ebe7cd7589bdbec34d9ae337752ead (diff) | |
download | gcc-f5a538e1647ae67cf204c5c3b1bd9cca5224dfd1.tar.gz |
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.
Diffstat (limited to 'libgomp')
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/icv-3.f90 | 60 | ||||
-rw-r--r-- | libgomp/testsuite/libgomp.fortran/icv-4.f90 | 45 |
2 files changed, 105 insertions, 0 deletions
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 |