[Patch] libgomp: Add stub omp_control_tool for OMPT

Tobias Burnus <[email protected]>
Newsgroups gmane.comp.gcc.patches,gmane.comp.gcc.fortran
Message-ID <[email protected]>
This patch adds the omp_control_tool API routine, returning for now
alwaysomp_control_tool_notool - it also adds the enum/PARAMETER related
to that routine plusomp_pause_stop_tool. I also updated the .texi file for this change. Tobias
PS: This will become more useful once OMPT supports lands (which is WIP).
omp.h-ompt.diff (text/x-patch, 22.8 KB)
libgomp: Add stub omp_control_tool for OMPT

Add the omp_control_tool (always returning omp_control_tool_notool); add it
and omp_control_tool/omp_control_tool_result enums/parameters to omp.h and
omp_lib.{h,mod}. Plus add OpenMP 6.0's omp_pause_stop_tool named constant.

Note that omp_control_tool uses the OpenMP 6.0 C/C++ prototype that uses an
enum omp_control_tool_t as first argument instead of an 'int'.

gcc/fortran/ChangeLog:

	* intrinsic.texi (OpenMP Modules): Add named parameters for
	omp_control_tool and omp_control_tool_result.

gcc/ChangeLog:

	* omp-general.cc (omp_runtime_api_procname): Add omp_control_tool.

libgomp/ChangeLog:

	* env.c (omp_control_tool): Stub implementation for omp_control_tool.
	* fortran.c (omp_control_tool_, omp_control_tool_8_): Add.
	* libgomp.map (OMP_6.0): Add for omp_control_tool*.
	* libgomp.texi (Tool Control Routine): Add for omp_control_tool.
	(OpenMP 6.0): Mark omp_pause_stop_tool as implemented.
	* omp.h.in (omp_pause_resource_t): Add omp_pause_stop_tool.
	(omp_control_tool_result_t): Add.
	(omp_control_tool_t): Add.
	* omp_lib.f90.in (omp_lib_kinds): Add omp_pause_stop_tool and
	omp_control_tool/omp_control_tool_result parameters.
	(omp_lib): Add omp_control_tool interface.
	* omp_lib.h.in: Add omp_pause_stop_tool and
	omp_control_tool/omp_control_tool_result parameters; add
	omp_control_tool interface.
	* testsuite/libgomp.c/omp-control-tools-1.c: New test.
	* testsuite/libgomp.fortran/omp-control-tools-1.f: New test.
	* testsuite/libgomp.fortran/omp-control-tools-1.f90: New test.

 gcc/fortran/intrinsic.texi                         | 24 ++++++-
 gcc/omp-general.cc                                 |  1 +
 libgomp/env.c                                      | 15 +++++
 libgomp/fortran.c                                  | 13 ++++
 libgomp/libgomp.map                                |  7 ++
 libgomp/libgomp.texi                               | 76 ++++++++++++++++++++--
 libgomp/omp.h.in                                   | 21 +++++-
 libgomp/omp_lib.f90.in                             | 41 ++++++++++--
 libgomp/omp_lib.h.in                               | 39 +++++++++++
 libgomp/testsuite/libgomp.c/omp-control-tools-1.c  | 21 ++++++
 .../libgomp.fortran/omp-control-tools-1.f          | 17 +++++
 .../libgomp.fortran/omp-control-tools-1.f90        | 17 +++++
 12 files changed, 280 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 1fffd74749b..6da3be0237b 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -16339,12 +16339,13 @@ kind @code{omp_lock_hint_kind}:
 @item @code{omp_sync_hint_speculative}
 @end table
 
-And the following two scalar integer named constants are of the
+And the following three scalar integer named constants are of the
 kind @code{omp_pause_resource_kind}:
 
 @table @asis
 @item @code{omp_pause_soft}
 @item @code{omp_pause_hard}
+@item @code{omp_pause_tool}
 @end table
 
 The following scalar integer named constants are of the kind
@@ -16413,6 +16414,27 @@ The following scalar integer named constants are of the kind
 @item @code{omp_low_lat_mem_space}
 @end table
 
+The following scalar integer named constants are of the kind
+@code{omp_control_tool_kind}:
+
+@table @asis
+@item @code{omp_control_tool_start}
+@item @code{omp_control_tool_pause}
+@item @code{omp_control_tool_flush}
+@item @code{omp_control_tool_end}
+@item @code{omp_control_tool_max}
+@end table
+
+The following scalar integer named constants are of the kind
+@code{omp_control_tool_result_kind}:
+
+@table @asis
+@item @code{omp_control_tool_notool}
+@item @code{omp_control_tool_nocallback}
+@item @code{omp_control_tool_success}
+@item @code{omp_control_tool_ignored}
+@end table
+
 
 
 @node OpenACC Module OPENACC
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 11f6917f7dd..cf8cddc50bc 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -4042,6 +4042,7 @@ omp_runtime_api_procname (const char *name)
       NULL,
       /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
 	 as DECL_NAME only omp_* and omp_*_8 appear.  */
+      "control_tool",
       "display_env",
       "get_ancestor_thread_num",
       "get_uid_from_device",
diff --git a/libgomp/env.c b/libgomp/env.c
index 15450d92497..8088085dd6c 100644
--- a/libgomp/env.c
+++ b/libgomp/env.c
@@ -2510,4 +2510,19 @@ initialize_env (void)
 
   goacc_profiling_initialize ();
 }
+
+
+/* Stub implementation; to be moved to ompt.cc once implemented.  */
+
+ialias (omp_control_tool)
+
+omp_control_tool_result_t
+omp_control_tool (omp_control_tool_t command, int modifier, void *arg)
+{
+  (void) command;
+  (void) modifier;
+  (void) arg;
+  return omp_control_tool_notool;
+}
+
 #endif /* LIBGOMP_OFFLOADED_ONLY */
diff --git a/libgomp/fortran.c b/libgomp/fortran.c
index db3c427af1e..59d1de2886e 100644
--- a/libgomp/fortran.c
+++ b/libgomp/fortran.c
@@ -103,6 +103,7 @@ ialias_redirect (omp_get_interop_str)
 ialias_redirect (omp_get_interop_name)
 ialias_redirect (omp_get_interop_type_desc)
 ialias_redirect (omp_get_interop_rc_desc)
+ialias_redirect (omp_control_tool)
 #endif
 
 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
@@ -872,4 +873,16 @@ omp_display_env_8_ (const int64_t *verbose)
   omp_display_env (!!*verbose);
 }
 
+omp_control_tool_result_t
+omp_control_tool_ (omp_control_tool_t command, int32_t modifier)
+{
+  return omp_control_tool (command, modifier, NULL);
+}
+
+omp_control_tool_result_t
+omp_control_tool_8_ (omp_control_tool_t command, int64_t modifier)
+{
+  return omp_control_tool (command, (int32_t) modifier, NULL);
+}
+
 #endif /* LIBGOMP_OFFLOADED_ONLY */
diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map
index 67e08a37116..06db9040e96 100644
--- a/libgomp/libgomp.map
+++ b/libgomp/libgomp.map
@@ -240,6 +240,13 @@ OMP_5.2 {
 	omp_in_explicit_task_;
 } OMP_5.1.1;
 
+OMP_6.0 {
+  global:
+	omp_control_tool;
+	omp_control_tool_;
+	omp_control_tool_8_;
+} OMP_5.2;
+
 GOMP_1.0 {
   global:
 	GOMP_atomic_end;
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index b4442069f66..c047cc0ff0e 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -644,7 +644,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
 @item Multi-word directives now use underscore by default @tab N @tab
 @item Relaxed Fortran restrictions to the @code{aligned} clause @tab N @tab
 @item Mapping lambda captures @tab N @tab
-@item New @code{omp_pause_stop_tool} constant for omp_pause_resource @tab N @tab
+@item New @code{omp_pause_stop_tool} constant for omp_pause_resource @tab Y @tab
 @item In Fortran (fixed and free source form), spaces between directive names are mandatory
       @tab N @tab
 @item Update of the map-type decay for mapping and @code{declare_mapper}
@@ -709,7 +709,7 @@ specification in version 5.2.
 * Event Routine::
 * Interoperability Routines::
 * Memory Management Routines::
-@c * Tool Control Routine::
+* Tool Control Routine::
 * Environment Display Routine::
 @end menu
 
@@ -3940,10 +3940,74 @@ was already deallocated or when the used allocator has already been destroyed.
 
 
 
-@c @node Tool Control Routine
-@c @section Tool Control Routine
-@c
-@c FIXME
+@node Tool Control Routine
+@section Tool Control Routine
+
+Routine that supports the use of the OpenMP tools interface (OMPT).
+
+@menu
+* omp_control_tool:: pass commands to a tool
+@end menu
+
+@node omp_control_tool
+@subsection @code{omp_control_tool} -- pass commands to a tool
+@table @asis
+@item @emph{Description}:
+The @code{omp_control_tool} routine can be used to pass commands to a tool. The
+values for @var{modifier} and @var{arg} are specific for the particular tool;
+for Fortran, @var{arg} is NULL.  The following predefined values for
+@var{command} are supported by all tools:
+
+@itemize
+@item @code{omp_control_tool_start}: Request that monitoring is started or resumed;
+      it has no effect if monitoring is already on or was turned off permanently.
+@item @code{omp_control_tool_pause}: Request that monitoring is temporarily paused;
+      it has no effect if monitoring is already paused or stopped.
+@item @code{omp_control_tool_flush}: Request flushing of any buffered data,
+      independently whether monitoring is currently active.
+@item @code{omp_control_tool_end}: Request that monitoring is turned off
+      permanently, flushing all output and terminating the tool.
+@end itemize
+
+For the listed standard commands, the @var{modifier} and @var{arg} arguments
+are ignored by the tool.
+
+Negative return values indicate that the tool has not processed the command;
+in particular, the return value is @code{omp_control_tool_notool} if OMPT is
+inactive and no tool is active; if it is active but no callback is registered
+for the tool-control event, @code{omp_control_tool_nocallback} is returned.
+On success, @code{omp_control_tool_success} is returned and
+@code{omp_control_tool_ignored} indicates that the tool received the command
+but ignored it. Positive return values greater than 64 are tool specific.
+
+GCC implements the OpenMP 6.0 version of this function for C and C++, which is
+not compatible with its type signature in previous versions of the OpenMP
+specification.  In older versions, the type @code{int} was used for the
+@var{command} argument in place of the enumerated type
+@code{omp_control_tool_t}; the return type likewise changed from @code{int} to
+@code{omp_control_tool_result_t}.
+
+@item @emph{C/C++}:
+@multitable @columnfractions .20 .80
+@item @emph{Prototype}: @tab @code{omp_control_tool_result_t omp_control_tool(}
+@item                   @tab @code{  omp_control_tool_t command, int modifier, void *arg)}
+@end multitable
+
+@item @emph{Fortran}:
+@multitable @columnfractions .20 .80
+@item @emph{Interface}: @tab @code{integer (kind=omp_control_tool_result_kind) &}
+@item                   @tab @code{   function omp_control_tool(command, modifier)}
+@item                   @tab @code{integer (kind=omp_control_tool_kind) command}
+@item                   @tab @code{integer :: modifier}
+@end multitable
+
+@c @item @emph{See also}:
+
+@item @emph{Reference}:
+@uref{https://www.openmp.org, OpenMP specification v6.0}, Section 31.1
+@end table
+
+
 
 @node Environment Display Routine
 @section Environment Display Routine
diff --git a/libgomp/omp.h.in b/libgomp/omp.h.in
index acf0756a19b..4a4c3e97b53 100644
--- a/libgomp/omp.h.in
+++ b/libgomp/omp.h.in
@@ -102,7 +102,8 @@ typedef struct __attribute__((__aligned__ (sizeof (void *)))) omp_depend_t
 typedef enum omp_pause_resource_t
 {
   omp_pause_soft = 1,
-  omp_pause_hard = 2
+  omp_pause_hard = 2,
+  omp_pause_stop_tool = 3
 } omp_pause_resource_t;
 
 typedef __INTPTR_TYPE__ omp_intptr_t;
@@ -240,6 +241,21 @@ typedef enum omp_interop_rc_t
   omp_irc_other = -6
 } omp_interop_rc_t;
 
+typedef enum omp_control_tool_t {
+    omp_control_tool_start = 1,
+    omp_control_tool_pause = 2,
+    omp_control_tool_flush = 3,
+    omp_control_tool_end = 4,
+    omp_control_tool_max = __INT32_MAX__
+} omp_control_tool_t;
+
+typedef enum omp_control_tool_result_t {
+    omp_control_tool_notool = -2,
+    omp_control_tool_nocallback = -1,
+    omp_control_tool_success = 0,
+    omp_control_tool_ignored = 1
+} omp_control_tool_result_t;
+
 #ifdef __cplusplus
 extern "C" {
 # define __GOMP_NOTHROW throw ()
@@ -435,6 +451,9 @@ extern const char *omp_get_interop_rc_desc (const omp_interop_t,
 extern int omp_get_device_from_uid (const char *) __GOMP_NOTHROW;
 extern const char *omp_get_uid_from_device (int) __GOMP_NOTHROW;
 
+extern omp_control_tool_result_t omp_control_tool (omp_control_tool_t, int,
+						   void*) __GOMP_NOTHROW;
+
 #ifdef __cplusplus
 }
 #endif
diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in
index b248921af53..015c59b1c81 100644
--- a/libgomp/omp_lib.f90.in
+++ b/libgomp/omp_lib.f90.in
@@ -24,9 +24,9 @@
 !  <http://www.gnu.org/licenses/>.
 
       module omp_lib_kinds
-        use iso_c_binding, only: c_int, c_intptr_t
+        use iso_c_binding, only: c_int, c_intptr_t, c_int32_t
         implicit none
-        private :: c_int, c_intptr_t
+        private :: c_int, c_intptr_t, c_int32_t
         integer, parameter :: omp_lock_kind = @OMP_LOCK_KIND@
         integer, parameter :: omp_nest_lock_kind = @OMP_NEST_LOCK_KIND@
         integer, parameter :: omp_sched_kind = 4
@@ -44,6 +44,8 @@
         integer, parameter :: omp_interop_fr_kind = c_int
         integer, parameter :: omp_interop_property_kind = c_int
         integer, parameter :: omp_interop_rc_kind = c_int
+        integer, parameter :: omp_control_tool_kind = c_int32_t
+        integer, parameter :: omp_control_tool_result_kind = c_int
         integer (omp_sched_kind), parameter :: omp_sched_static = 1
         integer (omp_sched_kind), parameter :: omp_sched_dynamic = 2
         integer (omp_sched_kind), parameter :: omp_sched_guided = 3
@@ -88,6 +90,8 @@
                  parameter :: omp_pause_soft = 1
         integer (kind=omp_pause_resource_kind), &
                  parameter :: omp_pause_hard = 2
+        integer (kind=omp_pause_resource_kind), &
+                 parameter :: omp_pause_tool = 3
         integer (kind=omp_alloctrait_key_kind), &
                  parameter :: omp_atk_sync_hint = 1
         integer (kind=omp_alloctrait_key_kind), &
@@ -215,6 +219,20 @@
         integer (omp_interop_rc_kind), parameter :: omp_irc_type_ptr = -4
         integer (omp_interop_rc_kind), parameter :: omp_irc_type_str = -5
         integer (omp_interop_rc_kind), parameter :: omp_irc_other = -6
+        integer (omp_control_tool_kind), parameter :: omp_control_tool_start = 1
+        integer (omp_control_tool_kind), parameter :: omp_control_tool_pause = 2
+        integer (omp_control_tool_kind), parameter :: omp_control_tool_flush = 3
+        integer (omp_control_tool_kind), parameter :: omp_control_tool_end = 4
+        integer (omp_control_tool_kind), &
+          parameter :: omp_control_tool_max = huge(0_omp_control_tool_kind)
+        integer (omp_control_tool_result_kind), &
+          parameter :: omp_control_tool_notool = -2
+        integer (omp_control_tool_result_kind), &
+          parameter :: omp_control_tool_nocallback = -1
+        integer (omp_control_tool_result_kind), &
+          parameter :: omp_control_tool_success = 0
+        integer (omp_control_tool_result_kind), &
+          parameter :: omp_control_tool_ignored = 1
 
         type omp_alloctrait
           integer (kind=omp_alloctrait_key_kind) key
@@ -1041,18 +1059,33 @@
         interface omp_get_uid_from_device
           ! Deviation from OpenMP 6.0: VALUE added.
           character(:) function omp_get_uid_from_device (device_num)
-            use iso_c_binding
+            use iso_c_binding, only: c_int32_t
             pointer :: omp_get_uid_from_device
             integer(c_int32_t), intent(in), value :: device_num
           end function omp_get_uid_from_device
 
           character(:) function omp_get_uid_from_device_8 (device_num)
-            use iso_c_binding
+            use iso_c_binding, only: c_int64_t
             pointer :: omp_get_uid_from_device_8
             integer(c_int64_t), intent(in), value :: device_num
           end function omp_get_uid_from_device_8
         end interface omp_get_uid_from_device
 
+        interface omp_control_tool
+          integer (kind=omp_control_tool_result_kind) function &
+              omp_control_tool (command, modifier)
+            import :: omp_control_tool_result_kind, omp_control_tool_kind
+            integer (kind=omp_control_tool_kind) command
+            integer(4) modifier
+          end function
+          integer (kind=omp_control_tool_result_kind) function &
+              omp_control_tool_8 (command, modifier)
+            import :: omp_control_tool_result_kind, omp_control_tool_kind
+            integer (kind=omp_control_tool_kind) command
+            integer(8) modifier
+          end function
+        end interface omp_control_tool
+
 #if _OPENMP >= 201811
 !GCC$ ATTRIBUTES DEPRECATED :: omp_get_nested, omp_set_nested
 !GCC$ ATTRIBUTES DEPRECATED :: omp_lock_hint_kind, omp_lock_hint_none
diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in
index a29fad7b3b9..ff9462fca9d 100644
--- a/libgomp/omp_lib.h.in
+++ b/libgomp/omp_lib.h.in
@@ -79,14 +79,18 @@
       parameter (omp_pause_resource_kind = 4)
       integer (omp_pause_resource_kind) omp_pause_soft
       integer (omp_pause_resource_kind) omp_pause_hard
+      integer (omp_pause_resource_kind) omp_pause_tool
       parameter (omp_pause_soft = 1)
       parameter (omp_pause_hard = 2)
+      parameter (omp_pause_tool = 3)
 
       integer omp_allocator_handle_kind, omp_alloctrait_key_kind
       integer omp_alloctrait_val_kind, omp_memspace_handle_kind
       integer omp_event_handle_kind
       integer omp_interop_kind, omp_interop_fr_kind
       integer omp_interop_property_kind, omp_interop_rc_kind
+      integer omp_control_tool_kind
+      integer omp_control_tool_result_kind
       parameter (omp_allocator_handle_kind = @INTPTR_T_KIND@)
       parameter (omp_alloctrait_key_kind = 4)
       parameter (omp_alloctrait_val_kind = @INTPTR_T_KIND@)
@@ -96,6 +100,8 @@
       parameter (omp_interop_fr_kind = 4)
       parameter (omp_interop_property_kind = 4)
       parameter (omp_interop_rc_kind = 4)
+      parameter (omp_control_tool_kind = 4)
+      parameter (omp_control_tool_result_kind = 4)
       integer (omp_alloctrait_key_kind) omp_atk_sync_hint
       integer (omp_alloctrait_key_kind) omp_atk_alignment
       integer (omp_alloctrait_key_kind) omp_atk_access
@@ -244,6 +250,24 @@
       parameter (omp_irc_type_ptr = -4)
       parameter (omp_irc_type_str = -5)
       parameter (omp_irc_other = -6)
+      integer (omp_control_tool_kind) omp_control_tool_start
+      integer (omp_control_tool_kind) omp_control_tool_pause
+      integer (omp_control_tool_kind) omp_control_tool_flush
+      integer (omp_control_tool_kind) omp_control_tool_end
+      integer (omp_control_tool_kind) omp_control_tool_max
+      parameter (omp_control_tool_start = 1)
+      parameter (omp_control_tool_pause = 2)
+      parameter (omp_control_tool_flush = 3)
+      parameter (omp_control_tool_end = 4)
+      parameter (omp_control_tool_max = huge(1_omp_control_tool_kind))
+      integer (omp_control_tool_result_kind) omp_control_tool_notool
+      integer (omp_control_tool_result_kind) omp_control_tool_nocallback
+      integer (omp_control_tool_result_kind) omp_control_tool_success
+      integer (omp_control_tool_result_kind) omp_control_tool_ignored
+      parameter (omp_control_tool_notool = -2)
+      parameter (omp_control_tool_nocallback = -1)
+      parameter (omp_control_tool_success = 0)
+      parameter (omp_control_tool_ignored = 1)
 
       type omp_alloctrait
         integer (omp_alloctrait_key_kind) key
@@ -662,3 +686,18 @@
           integer(c_int64_t), intent(in), value :: device_num
         end function omp_get_uid_from_device_8
       end interface omp_get_uid_from_device
+
+      interface omp_control_tool
+        integer (kind=omp_control_tool_result_kind) function                    &
+     &      omp_control_tool (command, modifier)
+          import
+          integer (kind=omp_control_tool_kind) command
+          integer(4) modifier
+        end function
+        integer (kind=omp_control_tool_result_kind) function                    &
+     &      omp_control_tool_8 (command, modifier)
+          import
+          integer (kind=omp_control_tool_kind) command
+          integer(8) modifier
+        end function
+      end interface omp_control_tool
diff --git a/libgomp/testsuite/libgomp.c/omp-control-tools-1.c b/libgomp/testsuite/libgomp.c/omp-control-tools-1.c
new file mode 100644
index 00000000000..596feadb8d9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/omp-control-tools-1.c
@@ -0,0 +1,21 @@
+#include <omp.h>
+
+int
+main ()
+{
+  omp_control_tool_t cmd = omp_control_tool_start;
+  omp_control_tool_result_t res;
+  res = omp_control_tool (omp_control_tool_start, 1, nullptr);
+  if (res != omp_control_tool_notool)
+    __builtin_abort ();
+  if (omp_control_tool_start != 1
+      || omp_control_tool_pause != 2
+      || omp_control_tool_flush != 3
+      || omp_control_tool_end != 4
+      || omp_control_tool_max != 2147483647 /* INT32_MAX */
+      || omp_control_tool_notool != -2
+      || omp_control_tool_nocallback != -1
+      || omp_control_tool_success != 0
+      || omp_control_tool_ignored != 1)
+    __builtin_abort ();
+}
diff --git a/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f b/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f
new file mode 100644
index 00000000000..a947fe657a3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f
@@ -0,0 +1,17 @@
+       !use omp_lib
+       implicit none
+       include "omp_lib.h"
+       if (omp_control_tool(omp_control_tool_start, 1)                          &
+     &    /= omp_control_tool_notool) stop 1
+       if (omp_control_tool_start /= 1                                          &
+     &    .or. omp_control_tool_pause /= 2                                      &
+     &    .or. omp_control_tool_flush /= 3                                      &
+     &    .or. omp_control_tool_end /= 4                                        &
+     &    .or. omp_control_tool_max /= 2147483647                               & ! INT32_MAX
+     &    .or. omp_control_tool_notool /= -2                                    &
+     &    .or. omp_control_tool_nocallback /= -1                                &
+     &    .or. omp_control_tool_success /= 0                                    &
+     &    .or. omp_control_tool_ignored /= 1) stop 2
+       if (kind(omp_control_tool_result_kind) /= 4                              &
+     &    .or. omp_control_tool_kind /= 4) stop 3
+       end
diff --git a/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f90 b/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f90
new file mode 100644
index 00000000000..f6838ced563
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f90
@@ -0,0 +1,17 @@
+       use omp_lib
+       implicit none
+       !include "omp_lib.h"
+       if (omp_control_tool(omp_control_tool_start, 1)                          &
+     &    /= omp_control_tool_notool) stop 1
+       if (omp_control_tool_start /= 1                                          &
+     &    .or. omp_control_tool_pause /= 2                                      &
+     &    .or. omp_control_tool_flush /= 3                                      &
+     &    .or. omp_control_tool_end /= 4                                        &
+     &    .or. omp_control_tool_max /= 2147483647                               & ! INT32_MAX
+     &    .or. omp_control_tool_notool /= -2                                    &
+     &    .or. omp_control_tool_nocallback /= -1                                &
+     &    .or. omp_control_tool_success /= 0                                    &
+     &    .or. omp_control_tool_ignored /= 1) stop 2
+       if (kind(omp_control_tool_result_kind) /= 4                              &
+     &    .or. omp_control_tool_kind /= 4) stop 3
+       end
omp.h-ompt.diff (text/x-patch, 22.8 KB)
libgomp: Add stub omp_control_tool for OMPT

Add the omp_control_tool (always returning omp_control_tool_notool); add it
and omp_control_tool/omp_control_tool_result enums/parameters to omp.h and
omp_lib.{h,mod}. Plus add OpenMP 6.0's omp_pause_stop_tool named constant.

Note that omp_control_tool uses the OpenMP 6.0 C/C++ prototype that uses an
enum omp_control_tool_t as first argument instead of an 'int'.

gcc/fortran/ChangeLog:

	* intrinsic.texi (OpenMP Modules): Add named parameters for
	omp_control_tool and omp_control_tool_result.

gcc/ChangeLog:

	* omp-general.cc (omp_runtime_api_procname): Add omp_control_tool.

libgomp/ChangeLog:

	* env.c (omp_control_tool): Stub implementation for omp_control_tool.
	* fortran.c (omp_control_tool_, omp_control_tool_8_): Add.
	* libgomp.map (OMP_6.0): Add for omp_control_tool*.
	* libgomp.texi (Tool Control Routine): Add for omp_control_tool.
	(OpenMP 6.0): Mark omp_pause_stop_tool as implemented.
	* omp.h.in (omp_pause_resource_t): Add omp_pause_stop_tool.
	(omp_control_tool_result_t): Add.
	(omp_control_tool_t): Add.
	* omp_lib.f90.in (omp_lib_kinds): Add omp_pause_stop_tool and
	omp_control_tool/omp_control_tool_result parameters.
	(omp_lib): Add omp_control_tool interface.
	* omp_lib.h.in: Add omp_pause_stop_tool and
	omp_control_tool/omp_control_tool_result parameters; add
	omp_control_tool interface.
	* testsuite/libgomp.c/omp-control-tools-1.c: New test.
	* testsuite/libgomp.fortran/omp-control-tools-1.f: New test.
	* testsuite/libgomp.fortran/omp-control-tools-1.f90: New test.

 gcc/fortran/intrinsic.texi                         | 24 ++++++-
 gcc/omp-general.cc                                 |  1 +
 libgomp/env.c                                      | 15 +++++
 libgomp/fortran.c                                  | 13 ++++
 libgomp/libgomp.map                                |  7 ++
 libgomp/libgomp.texi                               | 76 ++++++++++++++++++++--
 libgomp/omp.h.in                                   | 21 +++++-
 libgomp/omp_lib.f90.in                             | 41 ++++++++++--
 libgomp/omp_lib.h.in                               | 39 +++++++++++
 libgomp/testsuite/libgomp.c/omp-control-tools-1.c  | 21 ++++++
 .../libgomp.fortran/omp-control-tools-1.f          | 17 +++++
 .../libgomp.fortran/omp-control-tools-1.f90        | 17 +++++
 12 files changed, 280 insertions(+), 12 deletions(-)

diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 1fffd74749b..6da3be0237b 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -16339,12 +16339,13 @@ kind @code{omp_lock_hint_kind}:
 @item @code{omp_sync_hint_speculative}
 @end table
 
-And the following two scalar integer named constants are of the
+And the following three scalar integer named constants are of the
 kind @code{omp_pause_resource_kind}:
 
 @table @asis
 @item @code{omp_pause_soft}
 @item @code{omp_pause_hard}
+@item @code{omp_pause_tool}
 @end table
 
 The following scalar integer named constants are of the kind
@@ -16413,6 +16414,27 @@ The following scalar integer named constants are of the kind
 @item @code{omp_low_lat_mem_space}
 @end table
 
+The following scalar integer named constants are of the kind
+@code{omp_control_tool_kind}:
+
+@table @asis
+@item @code{omp_control_tool_start}
+@item @code{omp_control_tool_pause}
+@item @code{omp_control_tool_flush}
+@item @code{omp_control_tool_end}
+@item @code{omp_control_tool_max}
+@end table
+
+The following scalar integer named constants are of the kind
+@code{omp_control_tool_result_kind}:
+
+@table @asis
+@item @code{omp_control_tool_notool}
+@item @code{omp_control_tool_nocallback}
+@item @code{omp_control_tool_success}
+@item @code{omp_control_tool_ignored}
+@end table
+
 
 
 @node OpenACC Module OPENACC
diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 11f6917f7dd..cf8cddc50bc 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -4042,6 +4042,7 @@ omp_runtime_api_procname (const char *name)
       NULL,
       /* And finally calls available as omp_*, omp_*_ and omp_*_8_; however,
 	 as DECL_NAME only omp_* and omp_*_8 appear.  */
+      "control_tool",
       "display_env",
       "get_ancestor_thread_num",
       "get_uid_from_device",
diff --git a/libgomp/env.c b/libgomp/env.c
index 15450d92497..8088085dd6c 100644
--- a/libgomp/env.c
+++ b/libgomp/env.c
@@ -2510,4 +2510,19 @@ initialize_env (void)
 
   goacc_profiling_initialize ();
 }
+
+
+/* Stub implementation; to be moved to ompt.cc once implemented.  */
+
+ialias (omp_control_tool)
+
+omp_control_tool_result_t
+omp_control_tool (omp_control_tool_t command, int modifier, void *arg)
+{
+  (void) command;
+  (void) modifier;
+  (void) arg;
+  return omp_control_tool_notool;
+}
+
 #endif /* LIBGOMP_OFFLOADED_ONLY */
diff --git a/libgomp/fortran.c b/libgomp/fortran.c
index db3c427af1e..59d1de2886e 100644
--- a/libgomp/fortran.c
+++ b/libgomp/fortran.c
@@ -103,6 +103,7 @@ ialias_redirect (omp_get_interop_str)
 ialias_redirect (omp_get_interop_name)
 ialias_redirect (omp_get_interop_type_desc)
 ialias_redirect (omp_get_interop_rc_desc)
+ialias_redirect (omp_control_tool)
 #endif
 
 #ifndef LIBGOMP_GNU_SYMBOL_VERSIONING
@@ -872,4 +873,16 @@ omp_display_env_8_ (const int64_t *verbose)
   omp_display_env (!!*verbose);
 }
 
+omp_control_tool_result_t
+omp_control_tool_ (omp_control_tool_t command, int32_t modifier)
+{
+  return omp_control_tool (command, modifier, NULL);
+}
+
+omp_control_tool_result_t
+omp_control_tool_8_ (omp_control_tool_t command, int64_t modifier)
+{
+  return omp_control_tool (command, (int32_t) modifier, NULL);
+}
+
 #endif /* LIBGOMP_OFFLOADED_ONLY */
diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map
index 67e08a37116..06db9040e96 100644
--- a/libgomp/libgomp.map
+++ b/libgomp/libgomp.map
@@ -240,6 +240,13 @@ OMP_5.2 {
 	omp_in_explicit_task_;
 } OMP_5.1.1;
 
+OMP_6.0 {
+  global:
+	omp_control_tool;
+	omp_control_tool_;
+	omp_control_tool_8_;
+} OMP_5.2;
+
 GOMP_1.0 {
   global:
 	GOMP_atomic_end;
diff --git a/libgomp/libgomp.texi b/libgomp/libgomp.texi
index b4442069f66..c047cc0ff0e 100644
--- a/libgomp/libgomp.texi
+++ b/libgomp/libgomp.texi
@@ -644,7 +644,7 @@ to address of matching mapped list item per 5.1, Sect. 2.21.7.2 @tab N @tab
 @item Multi-word directives now use underscore by default @tab N @tab
 @item Relaxed Fortran restrictions to the @code{aligned} clause @tab N @tab
 @item Mapping lambda captures @tab N @tab
-@item New @code{omp_pause_stop_tool} constant for omp_pause_resource @tab N @tab
+@item New @code{omp_pause_stop_tool} constant for omp_pause_resource @tab Y @tab
 @item In Fortran (fixed and free source form), spaces between directive names are mandatory
       @tab N @tab
 @item Update of the map-type decay for mapping and @code{declare_mapper}
@@ -709,7 +709,7 @@ specification in version 5.2.
 * Event Routine::
 * Interoperability Routines::
 * Memory Management Routines::
-@c * Tool Control Routine::
+* Tool Control Routine::
 * Environment Display Routine::
 @end menu
 
@@ -3940,10 +3940,74 @@ was already deallocated or when the used allocator has already been destroyed.
 
 
 
-@c @node Tool Control Routine
-@c @section Tool Control Routine
-@c
-@c FIXME
+@node Tool Control Routine
+@section Tool Control Routine
+
+Routine that supports the use of the OpenMP tools interface (OMPT).
+
+@menu
+* omp_control_tool:: pass commands to a tool
+@end menu
+
+@node omp_control_tool
+@subsection @code{omp_control_tool} -- pass commands to a tool
+@table @asis
+@item @emph{Description}:
+The @code{omp_control_tool} routine can be used to pass commands to a tool. The
+values for @var{modifier} and @var{arg} are specific for the particular tool;
+for Fortran, @var{arg} is NULL.  The following predefined values for
+@var{command} are supported by all tools:
+
+@itemize
+@item @code{omp_control_tool_start}: Request that monitoring is started or resumed;
+      it has no effect if monitoring is already on or was turned off permanently.
+@item @code{omp_control_tool_pause}: Request that monitoring is temporarily paused;
+      it has no effect if monitoring is already paused or stopped.
+@item @code{omp_control_tool_flush}: Request flushing of any buffered data,
+      independently whether monitoring is currently active.
+@item @code{omp_control_tool_end}: Request that monitoring is turned off
+      permanently, flushing all output and terminating the tool.
+@end itemize
+
+For the listed standard commands, the @var{modifier} and @var{arg} arguments
+are ignored by the tool.
+
+Negative return values indicate that the tool has not processed the command;
+in particular, the return value is @code{omp_control_tool_notool} if OMPT is
+inactive and no tool is active; if it is active but no callback is registered
+for the tool-control event, @code{omp_control_tool_nocallback} is returned.
+On success, @code{omp_control_tool_success} is returned and
+@code{omp_control_tool_ignored} indicates that the tool received the command
+but ignored it. Positive return values greater than 64 are tool specific.
+
+GCC implements the OpenMP 6.0 version of this function for C and C++, which is
+not compatible with its type signature in previous versions of the OpenMP
+specification.  In older versions, the type @code{int} was used for the
+@var{command} argument in place of the enumerated type
+@code{omp_control_tool_t}; the return type likewise changed from @code{int} to
+@code{omp_control_tool_result_t}.
+
+@item @emph{C/C++}:
+@multitable @columnfractions .20 .80
+@item @emph{Prototype}: @tab @code{omp_control_tool_result_t omp_control_tool(}
+@item                   @tab @code{  omp_control_tool_t command, int modifier, void *arg)}
+@end multitable
+
+@item @emph{Fortran}:
+@multitable @columnfractions .20 .80
+@item @emph{Interface}: @tab @code{integer (kind=omp_control_tool_result_kind) &}
+@item                   @tab @code{   function omp_control_tool(command, modifier)}
+@item                   @tab @code{integer (kind=omp_control_tool_kind) command}
+@item                   @tab @code{integer :: modifier}
+@end multitable
+
+@c @item @emph{See also}:
+
+@item @emph{Reference}:
+@uref{https://www.openmp.org, OpenMP specification v6.0}, Section 31.1
+@end table
+
+
 
 @node Environment Display Routine
 @section Environment Display Routine
diff --git a/libgomp/omp.h.in b/libgomp/omp.h.in
index acf0756a19b..4a4c3e97b53 100644
--- a/libgomp/omp.h.in
+++ b/libgomp/omp.h.in
@@ -102,7 +102,8 @@ typedef struct __attribute__((__aligned__ (sizeof (void *)))) omp_depend_t
 typedef enum omp_pause_resource_t
 {
   omp_pause_soft = 1,
-  omp_pause_hard = 2
+  omp_pause_hard = 2,
+  omp_pause_stop_tool = 3
 } omp_pause_resource_t;
 
 typedef __INTPTR_TYPE__ omp_intptr_t;
@@ -240,6 +241,21 @@ typedef enum omp_interop_rc_t
   omp_irc_other = -6
 } omp_interop_rc_t;
 
+typedef enum omp_control_tool_t {
+    omp_control_tool_start = 1,
+    omp_control_tool_pause = 2,
+    omp_control_tool_flush = 3,
+    omp_control_tool_end = 4,
+    omp_control_tool_max = __INT32_MAX__
+} omp_control_tool_t;
+
+typedef enum omp_control_tool_result_t {
+    omp_control_tool_notool = -2,
+    omp_control_tool_nocallback = -1,
+    omp_control_tool_success = 0,
+    omp_control_tool_ignored = 1
+} omp_control_tool_result_t;
+
 #ifdef __cplusplus
 extern "C" {
 # define __GOMP_NOTHROW throw ()
@@ -435,6 +451,9 @@ extern const char *omp_get_interop_rc_desc (const omp_interop_t,
 extern int omp_get_device_from_uid (const char *) __GOMP_NOTHROW;
 extern const char *omp_get_uid_from_device (int) __GOMP_NOTHROW;
 
+extern omp_control_tool_result_t omp_control_tool (omp_control_tool_t, int,
+						   void*) __GOMP_NOTHROW;
+
 #ifdef __cplusplus
 }
 #endif
diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in
index b248921af53..015c59b1c81 100644
--- a/libgomp/omp_lib.f90.in
+++ b/libgomp/omp_lib.f90.in
@@ -24,9 +24,9 @@
 !  <http://www.gnu.org/licenses/>.
 
       module omp_lib_kinds
-        use iso_c_binding, only: c_int, c_intptr_t
+        use iso_c_binding, only: c_int, c_intptr_t, c_int32_t
         implicit none
-        private :: c_int, c_intptr_t
+        private :: c_int, c_intptr_t, c_int32_t
         integer, parameter :: omp_lock_kind = @OMP_LOCK_KIND@
         integer, parameter :: omp_nest_lock_kind = @OMP_NEST_LOCK_KIND@
         integer, parameter :: omp_sched_kind = 4
@@ -44,6 +44,8 @@
         integer, parameter :: omp_interop_fr_kind = c_int
         integer, parameter :: omp_interop_property_kind = c_int
         integer, parameter :: omp_interop_rc_kind = c_int
+        integer, parameter :: omp_control_tool_kind = c_int32_t
+        integer, parameter :: omp_control_tool_result_kind = c_int
         integer (omp_sched_kind), parameter :: omp_sched_static = 1
         integer (omp_sched_kind), parameter :: omp_sched_dynamic = 2
         integer (omp_sched_kind), parameter :: omp_sched_guided = 3
@@ -88,6 +90,8 @@
                  parameter :: omp_pause_soft = 1
         integer (kind=omp_pause_resource_kind), &
                  parameter :: omp_pause_hard = 2
+        integer (kind=omp_pause_resource_kind), &
+                 parameter :: omp_pause_tool = 3
         integer (kind=omp_alloctrait_key_kind), &
                  parameter :: omp_atk_sync_hint = 1
         integer (kind=omp_alloctrait_key_kind), &
@@ -215,6 +219,20 @@
         integer (omp_interop_rc_kind), parameter :: omp_irc_type_ptr = -4
         integer (omp_interop_rc_kind), parameter :: omp_irc_type_str = -5
         integer (omp_interop_rc_kind), parameter :: omp_irc_other = -6
+        integer (omp_control_tool_kind), parameter :: omp_control_tool_start = 1
+        integer (omp_control_tool_kind), parameter :: omp_control_tool_pause = 2
+        integer (omp_control_tool_kind), parameter :: omp_control_tool_flush = 3
+        integer (omp_control_tool_kind), parameter :: omp_control_tool_end = 4
+        integer (omp_control_tool_kind), &
+          parameter :: omp_control_tool_max = huge(0_omp_control_tool_kind)
+        integer (omp_control_tool_result_kind), &
+          parameter :: omp_control_tool_notool = -2
+        integer (omp_control_tool_result_kind), &
+          parameter :: omp_control_tool_nocallback = -1
+        integer (omp_control_tool_result_kind), &
+          parameter :: omp_control_tool_success = 0
+        integer (omp_control_tool_result_kind), &
+          parameter :: omp_control_tool_ignored = 1
 
         type omp_alloctrait
           integer (kind=omp_alloctrait_key_kind) key
@@ -1041,18 +1059,33 @@
         interface omp_get_uid_from_device
           ! Deviation from OpenMP 6.0: VALUE added.
           character(:) function omp_get_uid_from_device (device_num)
-            use iso_c_binding
+            use iso_c_binding, only: c_int32_t
             pointer :: omp_get_uid_from_device
             integer(c_int32_t), intent(in), value :: device_num
           end function omp_get_uid_from_device
 
           character(:) function omp_get_uid_from_device_8 (device_num)
-            use iso_c_binding
+            use iso_c_binding, only: c_int64_t
             pointer :: omp_get_uid_from_device_8
             integer(c_int64_t), intent(in), value :: device_num
           end function omp_get_uid_from_device_8
         end interface omp_get_uid_from_device
 
+        interface omp_control_tool
+          integer (kind=omp_control_tool_result_kind) function &
+              omp_control_tool (command, modifier)
+            import :: omp_control_tool_result_kind, omp_control_tool_kind
+            integer (kind=omp_control_tool_kind) command
+            integer(4) modifier
+          end function
+          integer (kind=omp_control_tool_result_kind) function &
+              omp_control_tool_8 (command, modifier)
+            import :: omp_control_tool_result_kind, omp_control_tool_kind
+            integer (kind=omp_control_tool_kind) command
+            integer(8) modifier
+          end function
+        end interface omp_control_tool
+
 #if _OPENMP >= 201811
 !GCC$ ATTRIBUTES DEPRECATED :: omp_get_nested, omp_set_nested
 !GCC$ ATTRIBUTES DEPRECATED :: omp_lock_hint_kind, omp_lock_hint_none
diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in
index a29fad7b3b9..ff9462fca9d 100644
--- a/libgomp/omp_lib.h.in
+++ b/libgomp/omp_lib.h.in
@@ -79,14 +79,18 @@
       parameter (omp_pause_resource_kind = 4)
       integer (omp_pause_resource_kind) omp_pause_soft
       integer (omp_pause_resource_kind) omp_pause_hard
+      integer (omp_pause_resource_kind) omp_pause_tool
       parameter (omp_pause_soft = 1)
       parameter (omp_pause_hard = 2)
+      parameter (omp_pause_tool = 3)
 
       integer omp_allocator_handle_kind, omp_alloctrait_key_kind
       integer omp_alloctrait_val_kind, omp_memspace_handle_kind
       integer omp_event_handle_kind
       integer omp_interop_kind, omp_interop_fr_kind
       integer omp_interop_property_kind, omp_interop_rc_kind
+      integer omp_control_tool_kind
+      integer omp_control_tool_result_kind
       parameter (omp_allocator_handle_kind = @INTPTR_T_KIND@)
       parameter (omp_alloctrait_key_kind = 4)
       parameter (omp_alloctrait_val_kind = @INTPTR_T_KIND@)
@@ -96,6 +100,8 @@
       parameter (omp_interop_fr_kind = 4)
       parameter (omp_interop_property_kind = 4)
       parameter (omp_interop_rc_kind = 4)
+      parameter (omp_control_tool_kind = 4)
+      parameter (omp_control_tool_result_kind = 4)
       integer (omp_alloctrait_key_kind) omp_atk_sync_hint
       integer (omp_alloctrait_key_kind) omp_atk_alignment
       integer (omp_alloctrait_key_kind) omp_atk_access
@@ -244,6 +250,24 @@
       parameter (omp_irc_type_ptr = -4)
       parameter (omp_irc_type_str = -5)
       parameter (omp_irc_other = -6)
+      integer (omp_control_tool_kind) omp_control_tool_start
+      integer (omp_control_tool_kind) omp_control_tool_pause
+      integer (omp_control_tool_kind) omp_control_tool_flush
+      integer (omp_control_tool_kind) omp_control_tool_end
+      integer (omp_control_tool_kind) omp_control_tool_max
+      parameter (omp_control_tool_start = 1)
+      parameter (omp_control_tool_pause = 2)
+      parameter (omp_control_tool_flush = 3)
+      parameter (omp_control_tool_end = 4)
+      parameter (omp_control_tool_max = huge(1_omp_control_tool_kind))
+      integer (omp_control_tool_result_kind) omp_control_tool_notool
+      integer (omp_control_tool_result_kind) omp_control_tool_nocallback
+      integer (omp_control_tool_result_kind) omp_control_tool_success
+      integer (omp_control_tool_result_kind) omp_control_tool_ignored
+      parameter (omp_control_tool_notool = -2)
+      parameter (omp_control_tool_nocallback = -1)
+      parameter (omp_control_tool_success = 0)
+      parameter (omp_control_tool_ignored = 1)
 
       type omp_alloctrait
         integer (omp_alloctrait_key_kind) key
@@ -662,3 +686,18 @@
           integer(c_int64_t), intent(in), value :: device_num
         end function omp_get_uid_from_device_8
       end interface omp_get_uid_from_device
+
+      interface omp_control_tool
+        integer (kind=omp_control_tool_result_kind) function                    &
+     &      omp_control_tool (command, modifier)
+          import
+          integer (kind=omp_control_tool_kind) command
+          integer(4) modifier
+        end function
+        integer (kind=omp_control_tool_result_kind) function                    &
+     &      omp_control_tool_8 (command, modifier)
+          import
+          integer (kind=omp_control_tool_kind) command
+          integer(8) modifier
+        end function
+      end interface omp_control_tool
diff --git a/libgomp/testsuite/libgomp.c/omp-control-tools-1.c b/libgomp/testsuite/libgomp.c/omp-control-tools-1.c
new file mode 100644
index 00000000000..596feadb8d9
--- /dev/null
+++ b/libgomp/testsuite/libgomp.c/omp-control-tools-1.c
@@ -0,0 +1,21 @@
+#include <omp.h>
+
+int
+main ()
+{
+  omp_control_tool_t cmd = omp_control_tool_start;
+  omp_control_tool_result_t res;
+  res = omp_control_tool (omp_control_tool_start, 1, nullptr);
+  if (res != omp_control_tool_notool)
+    __builtin_abort ();
+  if (omp_control_tool_start != 1
+      || omp_control_tool_pause != 2
+      || omp_control_tool_flush != 3
+      || omp_control_tool_end != 4
+      || omp_control_tool_max != 2147483647 /* INT32_MAX */
+      || omp_control_tool_notool != -2
+      || omp_control_tool_nocallback != -1
+      || omp_control_tool_success != 0
+      || omp_control_tool_ignored != 1)
+    __builtin_abort ();
+}
diff --git a/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f b/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f
new file mode 100644
index 00000000000..a947fe657a3
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f
@@ -0,0 +1,17 @@
+       !use omp_lib
+       implicit none
+       include "omp_lib.h"
+       if (omp_control_tool(omp_control_tool_start, 1)                          &
+     &    /= omp_control_tool_notool) stop 1
+       if (omp_control_tool_start /= 1                                          &
+     &    .or. omp_control_tool_pause /= 2                                      &
+     &    .or. omp_control_tool_flush /= 3                                      &
+     &    .or. omp_control_tool_end /= 4                                        &
+     &    .or. omp_control_tool_max /= 2147483647                               & ! INT32_MAX
+     &    .or. omp_control_tool_notool /= -2                                    &
+     &    .or. omp_control_tool_nocallback /= -1                                &
+     &    .or. omp_control_tool_success /= 0                                    &
+     &    .or. omp_control_tool_ignored /= 1) stop 2
+       if (kind(omp_control_tool_result_kind) /= 4                              &
+     &    .or. omp_control_tool_kind /= 4) stop 3
+       end
diff --git a/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f90 b/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f90
new file mode 100644
index 00000000000..f6838ced563
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/omp-control-tools-1.f90
@@ -0,0 +1,17 @@
+       use omp_lib
+       implicit none
+       !include "omp_lib.h"
+       if (omp_control_tool(omp_control_tool_start, 1)                          &
+     &    /= omp_control_tool_notool) stop 1
+       if (omp_control_tool_start /= 1                                          &
+     &    .or. omp_control_tool_pause /= 2                                      &
+     &    .or. omp_control_tool_flush /= 3                                      &
+     &    .or. omp_control_tool_end /= 4                                        &
+     &    .or. omp_control_tool_max /= 2147483647                               & ! INT32_MAX
+     &    .or. omp_control_tool_notool /= -2                                    &
+     &    .or. omp_control_tool_nocallback /= -1                                &
+     &    .or. omp_control_tool_success /= 0                                    &
+     &    .or. omp_control_tool_ignored /= 1) stop 2
+       if (kind(omp_control_tool_result_kind) /= 4                              &
+     &    .or. omp_control_tool_kind /= 4) stop 3
+       end
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.