OpenMP: Fix omp_get_device_from_uid, minor cleanup

In Fortran, omp_get_device_from_uid can also accept substrings, which are
then not NUL terminated.  Fixed by introducing a fortran.c wrapper function.
Additionally, in case of a fail the plugin functions now return NULL instead
of failing fatally such that a fall-back UID is generated.

gcc/ChangeLog:

	* omp-general.cc (omp_runtime_api_procname): Strip "omp_" from
	string; move get_device_from_uid as now a '_' suffix exists.

libgomp/ChangeLog:

	* fortran.c (omp_get_device_from_uid_): New function.
	* libgomp.map (GOMP_6.0): Add it.
	* oacc-host.c (host_dispatch): Init '.uid' and '.get_uid_func'.
	* omp_lib.f90.in: Make it used by removing bind(C).
	* omp_lib.h.in: Likewise.
	* target.c (omp_get_device_from_uid): Ensure the device is initialized.
	* plugin/plugin-gcn.c (GOMP_OFFLOAD_get_uid): Add function comment;
	return NULL in case of an error.
	* plugin/plugin-nvptx.c (GOMP_OFFLOAD_get_uid): Likewise.
	* testsuite/libgomp.fortran/device_uid.f90: Update to test substrings.

10 files changed, 60 insertions, 15 deletions

diff --git a/gcc/omp-general.cc b/gcc/omp-general.cc
index 12788ad..3dfbc31 100644
--- a/gcc/omp-general.cc
+++ b/gcc/omp-general.cc
@@ -3260,7 +3260,6 @@ omp_runtime_api_procname (const char *name)
       "alloc",
       "calloc",
       "free",
-      "get_device_from_uid",
       "get_interop_int",
       "get_interop_ptr",
       "get_mapped_ptr",
@@ -3290,6 +3289,7 @@ omp_runtime_api_procname (const char *name)
       "get_cancellation",
       "get_default_allocator",
       "get_default_device",
+      "get_device_from_uid",
       "get_device_num",
       "get_dynamic",
       "get_initial_device",
@@ -3339,7 +3339,7 @@ omp_runtime_api_procname (const char *name)
 	 as DECL_NAME only omp_* and omp_*_8 appear.  */
       "display_env",
       "get_ancestor_thread_num",
-      "omp_get_uid_from_device",
+      "get_uid_from_device",
       "get_partition_place_nums",
       "get_place_num_procs",
       "get_place_proc_ids",
diff --git a/libgomp/fortran.c b/libgomp/fortran.c
index 9b7f093..7976e5b 100644
--- a/libgomp/fortran.c
+++ b/libgomp/fortran.c
@@ -834,6 +834,24 @@ omp_get_interop_rc_desc_ (const char **res, size_t *res_len,
   *res_len = *res ? strlen (*res) : 0;
 }
 
+int
+omp_get_device_from_uid_ (const char *uid, size_t uid_len)
+{
+#ifndef LIBGOMP_OFFLOADED_ONLY
+  char *str = __builtin_alloca ((uid_len + 1) * sizeof (char));
+  memcpy (str, uid, uid_len * sizeof (char));
+  str[uid_len] = '\0';
+  return omp_get_device_from_uid (str);
+#else
+  /* Inside the target region, invoking this routine is undefined
+     behavior; thus, resolve it already here - instead of inside
+     libgomp/config/.../target.c.
+     Note that on nvptx __builtin_alloca is defined, but fails with a sorry
+     during compilation, as it is unsupported until isa 7.3 / sm_52.  */
+  return omp_invalid_device;
+#endif
+}
+
 void
 omp_get_uid_from_device_ (const char **res, size_t *res_len,
 			  int32_t device_num)
diff --git a/libgomp/libgomp.map b/libgomp/libgomp.map
index 0023d3e..4530b3a 100644
--- a/libgomp/libgomp.map
+++ b/libgomp/libgomp.map
@@ -446,6 +446,7 @@ GOMP_5.1.3 {
 GOMP_6.0 {
   global:
 	omp_get_device_from_uid;
+	omp_get_device_from_uid_;
 	omp_get_uid_from_device;
 	omp_get_uid_from_device_;
 	omp_get_uid_from_device_8_;
diff --git a/libgomp/oacc-host.c b/libgomp/oacc-host.c
index 5efdf7f..7d4362e 100644
--- a/libgomp/oacc-host.c
+++ b/libgomp/oacc-host.c
@@ -263,6 +263,7 @@ host_openacc_destroy_thread_data (void *tls_data __attribute__ ((unused)))
 static struct gomp_device_descr host_dispatch =
   {
     .name = "host",
+    .uid = NULL,
     .capabilities = (GOMP_OFFLOAD_CAP_SHARED_MEM
 		     | GOMP_OFFLOAD_CAP_NATIVE_EXEC
 		     | GOMP_OFFLOAD_CAP_OPENACC_200),
@@ -270,6 +271,7 @@ static struct gomp_device_descr host_dispatch =
     .type = OFFLOAD_TARGET_TYPE_HOST,
 
     .get_name_func = host_get_name,
+    .get_uid_func = NULL,
     .get_caps_func = host_get_caps,
     .get_type_func = host_get_type,
     .get_num_devices_func = host_get_num_devices,
diff --git a/libgomp/omp_lib.f90.in b/libgomp/omp_lib.f90.in
index 360352c..77f2bd4 100644
--- a/libgomp/omp_lib.f90.in
+++ b/libgomp/omp_lib.f90.in
@@ -1004,10 +1004,9 @@
         end interface
 
         interface
-          ! Note: In gfortran, strings are \0 termined
-          integer(c_int) function omp_get_device_from_uid(uid) bind(C)
+          integer(c_int) function omp_get_device_from_uid (uid)
             use iso_c_binding
-            character(c_char), intent(in) :: uid(*)
+            character, intent(in) :: uid(*)
           end function omp_get_device_from_uid
         end interface
 
diff --git a/libgomp/omp_lib.h.in b/libgomp/omp_lib.h.in
index 1003861..fcfc737 100644
--- a/libgomp/omp_lib.h.in
+++ b/libgomp/omp_lib.h.in
@@ -612,10 +612,9 @@
       end interface
 
       interface
-!       Note: In gfortran, strings are \0 termined
-        integer(c_int) function omp_get_device_from_uid(uid) bind(C)
+        integer(c_int) function omp_get_device_from_uid (uid)
           use iso_c_binding
-          character(c_char), intent(in) :: uid(*)
+          character, intent(in) :: uid(*)
         end function omp_get_device_from_uid
       end interface
 
diff --git a/libgomp/plugin/plugin-gcn.c b/libgomp/plugin/plugin-gcn.c
index bf6ad37..f805206 100644
--- a/libgomp/plugin/plugin-gcn.c
+++ b/libgomp/plugin/plugin-gcn.c
@@ -3316,6 +3316,9 @@ GOMP_OFFLOAD_get_name (void)
   return "gcn";
 }
 
+/* Return the UID; if not available return NULL.
+   Returns freshly allocated memoy.  */
+
 const char *
 GOMP_OFFLOAD_get_uid (int ord)
 {
@@ -3328,7 +3331,10 @@ GOMP_OFFLOAD_get_uid (int ord)
   status = hsa_fns.hsa_agent_get_info_fn (agent->id, HSA_AMD_AGENT_INFO_UUID,
 					  str);
   if (status != HSA_STATUS_SUCCESS)
-    hsa_fatal ("Could not obtain device UUID", status);
+    {
+      free (str);
+      return NULL;
+    }
   return str;
 }
 
diff --git a/libgomp/plugin/plugin-nvptx.c b/libgomp/plugin/plugin-nvptx.c
index a8b85bd..9310241 100644
--- a/libgomp/plugin/plugin-nvptx.c
+++ b/libgomp/plugin/plugin-nvptx.c
@@ -1242,6 +1242,9 @@ GOMP_OFFLOAD_get_name (void)
   return "nvptx";
 }
 
+/* Return the UID; if not available return NULL.
+   Returns freshly allocated memoy.  */
+
 const char *
 GOMP_OFFLOAD_get_uid (int ord)
 {
@@ -1254,9 +1257,9 @@ GOMP_OFFLOAD_get_uid (int ord)
   else if (CUDA_CALL_EXISTS (cuDeviceGetUuid))
     r = CUDA_CALL_NOCHECK (cuDeviceGetUuid, &s, dev->dev);
   else
-    r = CUDA_ERROR_NOT_FOUND;
+    return NULL;
   if (r != CUDA_SUCCESS)
-    GOMP_PLUGIN_fatal ("cuDeviceGetUuid error: %s", cuda_error (r));
+    NULL;
 
   size_t len = strlen ("GPU-12345678-9abc-defg-hijk-lmniopqrstuv");
   char *str = (char *) GOMP_PLUGIN_malloc (len + 1);
diff --git a/libgomp/target.c b/libgomp/target.c
index f9aa178..abd1ac8b 100644
--- a/libgomp/target.c
+++ b/libgomp/target.c
@@ -5268,8 +5268,11 @@ omp_get_device_from_uid (const char *uid)
   if (strcmp (uid, str_omp_initial_device) == 0)
     return omp_initial_device;
   for (int dev = 0; dev < gomp_get_num_devices (); dev++)
-    if (strcmp (uid, gomp_get_uid_for_device (&devices[dev], dev)) == 0)
-      return dev;
+    {
+      struct gomp_device_descr *devicep = resolve_device (dev, false);
+      if (strcmp (uid, gomp_get_uid_for_device (devicep, dev)) == 0)
+	return dev;
+    }
   return omp_invalid_device;
 }
 
diff --git a/libgomp/testsuite/libgomp.fortran/device_uid.f90 b/libgomp/testsuite/libgomp.fortran/device_uid.f90
index 4c2a28a..504f6ca 100644
--- a/libgomp/testsuite/libgomp.fortran/device_uid.f90
+++ b/libgomp/testsuite/libgomp.fortran/device_uid.f90
@@ -12,7 +12,7 @@ program main
 
   do i = omp_invalid_device - 1, omp_get_num_devices () + 1
     str => omp_get_uid_from_device (i)
-    dev = omp_get_device_from_uid (str);
+    dev = omp_get_device_from_uid (str)
 ! print *, i, str, dev
     if (i < omp_initial_device .or. i > omp_get_num_devices ()) then
       if (dev /= omp_invalid_device .or. associated(str)) &
@@ -30,12 +30,26 @@ program main
       stop 4
     end if
     strs(dev)%str => str
+
+    block
+      ! Check substring handling
+      character(len=100) :: long_str
+      integer :: dev2
+      long_str = str // "ABCDEF"
+      dev2 = omp_get_device_from_uid (long_str(1:len(str)))
+      if (i == omp_initial_device .or. i == omp_get_num_devices ()) then
+        if (dev2 /= omp_initial_device .and. dev2  /= omp_get_num_devices ()) &
+          stop 5
+      else if (dev /= dev2) then
+        stop 6
+      end if
+    end block
   end do
 
   do i = 0, omp_get_num_devices () - 1
     do j = i + 1, omp_get_num_devices ()
       if (strs(i)%str == strs(j)%str) &
-        stop 4
+        stop 7
     end do
   end do
   deallocate (strs)