OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fortran version of libgomp.c-c++-common/icv-{3,4}.c

Browse Source 
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.
This commit is contained in:
Tobias Burnus 2021-10-12 10:54:18 +02:00
parent eb92cd57a1
commit f5a538e164
2 changed files with 105 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
libgomp/testsuite/libgomp.fortran/icv-3.f90 Normal file
View File

@ -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

45
libgomp/testsuite/libgomp.fortran/icv-4.f90 Normal file
View File

@ -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