diff mbox series

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)

Message ID a15dff58-0b57-4dd2-adff-cf41db689e5a@codesourcery.com
State New
Headers show
Series 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) | expand

Commit Message

Tobias Burnus Oct. 12, 2021, 8:41 a.m. UTC 
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

Comments

Jakub Jelinek Oct. 12, 2021, 8:45 a.m. UTC | #1 
On Tue, Oct 12, 2021 at 10:41:28AM +0200, Tobias Burnus wrote:
> 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.

Ok, thanks.

	Jakub
diff mbox series

Patch

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