From 6cf56637cc710b555f35c325c15c86a60cf0f26d Mon Sep 17 00:00:00 2001
From: Tobias Burnus <tobias@codesourcery.com>
Date: Tue, 12 Oct 2021 10:55:32 +0200
Subject: [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.

(cherry picked from commit f5a538e1647ae67cf204c5c3b1bd9cca5224dfd1)
---
 libgomp/ChangeLog.omp                       |  8 +++
 libgomp/testsuite/libgomp.fortran/icv-3.f90 | 60 +++++++++++++++++++++
 libgomp/testsuite/libgomp.fortran/icv-4.f90 | 45 ++++++++++++++++
 3 files changed, 113 insertions(+)
 create mode 100644 libgomp/testsuite/libgomp.fortran/icv-3.f90
 create mode 100644 libgomp/testsuite/libgomp.fortran/icv-4.f90

diff --git a/libgomp/ChangeLog.omp b/libgomp/ChangeLog.omp
index 8cf858908ff6..b39fe5dd2a40 100644
--- a/libgomp/ChangeLog.omp
+++ b/libgomp/ChangeLog.omp
@@ -1,3 +1,11 @@
+2021-10-12  Tobias Burnus  <tobias@codesourcery.com>
+
+	Backported from master:
+	2021-10-12  Tobias Burnus  <tobias@codesourcery.com>
+
+	* testsuite/libgomp.fortran/icv-3.f90: New.
+	* testsuite/libgomp.fortran/icv-4.f90: New.
+
 2021-10-12  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from master:
diff --git a/libgomp/testsuite/libgomp.fortran/icv-3.f90 b/libgomp/testsuite/libgomp.fortran/icv-3.f90
new file mode 100644
index 000000000000..b2ccd776223f
--- /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 000000000000..f76c96d7d0d8
--- /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
-- 
2.47.2