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 --git a/libgomp/testsuite/libgomp.fortran/icv-3.f90 b/libgomp/testsuite/libgomp.fortran/icv-3.f90
new file mode 100644 (file)
index 0000000..b2ccd77
--- /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 (file)
index 0000000..f76c96d
--- /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