diff mbox series

[og8] Add OpenACC 2.6 `acc_get_property' support

Message ID alpine.DEB.2.21.9999.1812031551070.55818@build7-trusty-cs.sje.mentorg.com
State Accepted
Headers show
Series [og8] Add OpenACC 2.6 `acc_get_property' support | expand

Commit Message

Maciej W. Rozycki Dec. 3, 2018, 4:51 p.m. UTC 
Add generic support for the OpenACC 2.6 `acc_get_property' and 
`acc_get_property_string' routines, as well as full handlers for the 
host and the NVPTX offload targets and a minimal handler for the HSA 
offload target.

Include test cases for both C/C++ and Fortran support, both producing:

OpenACC vendor: GNU
OpenACC name: GOMP
OpenACC driver: 1.0

with the host driver and output like:

OpenACC vendor: Nvidia
OpenACC total memory: 12651462656
OpenACC free memory: 12202737664
OpenACC name: TITAN V
OpenACC driver: 9.1

with the NVPTX driver.

	include/
	* gomp-constants.h (GOMP_DEVICE_CURRENT): New macro.
	(GOMP_DEVICE_PROPERTY_MEMORY, GOMP_DEVICE_PROPERTY_FREE_MEMORY)
	(GOMP_DEVICE_PROPERTY_NAME, GOMP_DEVICE_PROPERTY_VENDOR)
	(GOMP_DEVICE_PROPERTY_DRIVER): Likewise.
	(GOMP_DEVICE_PROPERTY_STRING_MASK): Likewise.

	libgomp/
	* libgomp.h (gomp_device_descr): Add `get_property_func' member.
	* libgomp-plugin.h (gomp_device_property_value): New union.
	(gomp_device_property_value): New prototype.
	* openacc.h (acc_device_t): Add `acc_device_current' enumeration
	constant.
	(acc_device_property_t): New enum.
	(acc_get_property, acc_get_property_string): New prototypes.
	* oacc-init.c (acc_get_device_type): Also assert on
	`!acc_device_current' result.
	(get_property_any, acc_get_property, acc_get_property_string): 
	New functions.
	* openacc.f90 (openacc_kinds): From `iso_fortran_env' also 
	import `int64'.  Add `acc_device_current' and 
	`acc_property_memory', `acc_property_free_memory', 
	`acc_property_name', `acc_property_vendor' and
	`acc_property_driver' constants.  Add `acc_device_property' data
	type.
	(openacc_internal): Add `acc_get_property' and 
	`acc_get_property_string' interfaces.  Add `acc_get_property_h',
	`acc_get_property_string_h', `acc_get_property_l' and 
	`acc_get_property_string_l'.
	(openacc_c_string): New module.
	* oacc-host.c (host_get_property): New function.
	(host_dispatch): Wire it.
	* target.c (gomp_load_plugin_for_device): Handle `get_property'.
	* libgomp.map (OACC_2.6): Add `acc_get_property', 
	`acc_get_property_h_', `acc_get_property_string' and 
	`acc_get_property_string_h_' symbols.
	* libgomp.texi (OpenACC Runtime Library Routines): Add 
	`acc_get_property'.
	(acc_get_property): New node.

	* plugin/plugin-hsa.c (GOMP_OFFLOAD_get_property): New function.
	* plugin/plugin-nvptx.c (CUDA_CALLS): Add `cuDeviceGetName', 
	`cuDeviceTotalMem', `cuDriverGetVersion' and `cuMemGetInfo' 
	calls.
	(GOMP_OFFLOAD_get_property): New function.

	* testsuite/libgomp.oacc-c-c++-common/acc-get-property.c: New 
	test.
	* testsuite/libgomp.oacc-fortran/acc-get-property.f: New test.
---
Hi,

 This has passed regression-testing with the `x86_64-linux-gnu' target and 
the `nvptx-none' offload target.  I will appreciate feedback and if none 
has been given in a couple of days' time, then I will commit this change 
to the og8 branch.

  Maciej
---
 include/gomp-constants.h                                       |   14 +
 libgomp/libgomp-plugin.h                                       |    8 
 libgomp/libgomp.h                                              |    1 
 libgomp/libgomp.map                                            |    4 
 libgomp/libgomp.texi                                           |   39 +++
 libgomp/oacc-host.c                                            |   22 +
 libgomp/oacc-init.c                                            |   99 ++++++++
 libgomp/openacc.f90                                            |  116 +++++++++-
 libgomp/openacc.h                                              |   15 +
 libgomp/plugin/plugin-hsa.c                                    |   26 ++
 libgomp/plugin/plugin-nvptx.c                                  |   91 +++++++
 libgomp/target.c                                               |    1 
 libgomp/testsuite/libgomp.oacc-c-c++-common/acc-get-property.c |   37 +++
 libgomp/testsuite/libgomp.oacc-fortran/acc-get-property.f      |   33 ++
 14 files changed, 504 insertions(+), 2 deletions(-)

gcc-openacc-acc-get-property.diff

Comments

Chung-Lin Tang Dec. 5, 2018, 10:12 a.m. UTC | #1 
Hi Maciej, please see below:

On 2018/12/4 12:51 AM, Maciej W. Rozycki wrote:
> +module openacc_c_string
> +  implicit none
> +
> +  interface
> +    function strlen (s) bind (C, name = "strlen")
> +      use iso_c_binding, only: c_ptr, c_size_t
> +      type (c_ptr), intent(in), value :: s
> +      integer (c_size_t) :: strlen
> +    end function
> +  end interface
> +
> +end module

> +subroutine acc_get_property_string_h (n, d, p, s)
> +  use iso_c_binding, only: c_char, c_int, c_ptr, c_f_pointer
> +  use openacc_internal, only: acc_get_property_string_l
> +  use openacc_c_string, only: strlen
> +  use openacc_kinds
...> +  pint = int (p, c_int)
> +  cptr = acc_get_property_string_l (n, d, pint)
> +  clen = int (strlen (cptr))
> +  call c_f_pointer (cptr, sptr, [clen])

AFAIK, things like strlen are already available in iso_c_binding, in forms like "C_strlen".
Can you check again if that 'openacc_c_string' module is really necessary?

> +union gomp_device_property_value
> +GOMP_OFFLOAD_get_property (int n, int prop)
> +{
> +  union gomp_device_property_value propval = { .val = 0 };
> +
> +  pthread_mutex_lock (&ptx_dev_lock);
> +
> +  if (!nvptx_init () || n >= nvptx_get_num_devices ())
> +    {
> +      pthread_mutex_unlock (&ptx_dev_lock);
> +      return propval;
> +    }
> +
> +  switch (prop)
> +    {
> +    case GOMP_DEVICE_PROPERTY_MEMORY:
> +      {
> +	size_t total_mem;
> +	CUdevice dev;
> +
> +	CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
> +	CUDA_CALL_ERET (propval, cuDeviceTotalMem, &total_mem, dev);
> +	propval.val = total_mem;
> +      }
> +      break;
> +    case GOMP_DEVICE_PROPERTY_FREE_MEMORY:
> +      {
> +	size_t total_mem;
> +	size_t free_mem;
> +	CUdevice ctxdev;
> +	CUdevice dev;
> +
> +	CUDA_CALL_ERET (propval, cuCtxGetDevice, &ctxdev);
> +	CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
> +	if (dev == ctxdev)
> +	  CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
> +	else if (ptx_devices[n])
> +	  {
> +	    CUcontext old_ctx;
> +
> +	    CUDA_CALL_ERET (propval, cuCtxPushCurrent, ptx_devices[n]->ctx);
> +	    CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
> +	    CUDA_CALL_ASSERT (cuCtxPopCurrent, &old_ctx);
> +	  }
> +	else
> +	  {
> +	    CUcontext new_ctx;
> +
> +	    CUDA_CALL_ERET (propval, cuCtxCreate, &new_ctx, CU_CTX_SCHED_AUTO,
> +			    dev);
> +	    CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
> +	    CUDA_CALL_ASSERT (cuCtxDestroy, new_ctx);
> +	  }

(I'm CCing Tom here, as he is maintainer for these parts)

As we discussed earlier on our internal list, I think properly using GOMP_OFFLOAD_init_device
is the right way, instead of using the lower level CUDA context create/destroy.

I did not mean for you to first init the device and then immediately destroy it by
GOMP_OFFLOAD_fini_device, just to obtain the property, but for you to just take the opportunity to initialize
it for use, and leave it there until program exit. That should save resources overall.
(BTW, CUDA contexts should be quite expensive to create/destroy, using a cuCtxCreate/Destroy pair is probably
almost as slow)

Tom, do you have any comments on how to best write this part?

Thanks,
Chung-Lin
Maciej W. Rozycki Dec. 5, 2018, 6:16 p.m. UTC | #2 
Hi Chung-Lin,

> > +module openacc_c_string
> > +  implicit none
> > +
> > +  interface
> > +    function strlen (s) bind (C, name = "strlen")
> > +      use iso_c_binding, only: c_ptr, c_size_t
> > +      type (c_ptr), intent(in), value :: s
> > +      integer (c_size_t) :: strlen
> > +    end function
> > +  end interface
> > +
> > +end module
> 
> > +subroutine acc_get_property_string_h (n, d, p, s)
> > +  use iso_c_binding, only: c_char, c_int, c_ptr, c_f_pointer
> > +  use openacc_internal, only: acc_get_property_string_l
> > +  use openacc_c_string, only: strlen
> > +  use openacc_kinds
> ...> +  pint = int (p, c_int)
> > +  cptr = acc_get_property_string_l (n, d, pint)
> > +  clen = int (strlen (cptr))
> > +  call c_f_pointer (cptr, sptr, [clen])
> 
> AFAIK, things like strlen are already available in iso_c_binding, in forms
> like "C_strlen".
> Can you check again if that 'openacc_c_string' module is really necessary?

 Any pointers please?

 I can't see `c_strlen' or any equivalent interface defined either in the 
Fortran 2003 language standard or in GCC documentation, and neither `grep' 
over the GCC tree shows anything relevant.  The `iso_c_binding' module 
defines only a bunch of procedures according to said documentation.  The 
`strlen' function provided here has been taken from one of our Fortran 
test cases, which strongly indicates there's no such API already available 
or whoever wrote the test case would have chosen to use it I suppose.

> > +union gomp_device_property_value
> > +GOMP_OFFLOAD_get_property (int n, int prop)
> > +{
> > +  union gomp_device_property_value propval = { .val = 0 };
> > +
> > +  pthread_mutex_lock (&ptx_dev_lock);
> > +
> > +  if (!nvptx_init () || n >= nvptx_get_num_devices ())
> > +    {
> > +      pthread_mutex_unlock (&ptx_dev_lock);
> > +      return propval;
> > +    }
> > +
> > +  switch (prop)
> > +    {
> > +    case GOMP_DEVICE_PROPERTY_MEMORY:
> > +      {
> > +	size_t total_mem;
> > +	CUdevice dev;
> > +
> > +	CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
> > +	CUDA_CALL_ERET (propval, cuDeviceTotalMem, &total_mem, dev);
> > +	propval.val = total_mem;
> > +      }
> > +      break;
> > +    case GOMP_DEVICE_PROPERTY_FREE_MEMORY:
> > +      {
> > +	size_t total_mem;
> > +	size_t free_mem;
> > +	CUdevice ctxdev;
> > +	CUdevice dev;
> > +
> > +	CUDA_CALL_ERET (propval, cuCtxGetDevice, &ctxdev);
> > +	CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
> > +	if (dev == ctxdev)
> > +	  CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
> > +	else if (ptx_devices[n])
> > +	  {
> > +	    CUcontext old_ctx;
> > +
> > +	    CUDA_CALL_ERET (propval, cuCtxPushCurrent, ptx_devices[n]->ctx);
> > +	    CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
> > +	    CUDA_CALL_ASSERT (cuCtxPopCurrent, &old_ctx);
> > +	  }
> > +	else
> > +	  {
> > +	    CUcontext new_ctx;
> > +
> > +	    CUDA_CALL_ERET (propval, cuCtxCreate, &new_ctx, CU_CTX_SCHED_AUTO,
> > +			    dev);
> > +	    CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
> > +	    CUDA_CALL_ASSERT (cuCtxDestroy, new_ctx);
> > +	  }
> 
> (I'm CCing Tom here, as he is maintainer for these parts)
> 
> As we discussed earlier on our internal list, I think properly using
> GOMP_OFFLOAD_init_device
> is the right way, instead of using the lower level CUDA context
> create/destroy.
> 
> I did not mean for you to first init the device and then immediately destroy
> it by
> GOMP_OFFLOAD_fini_device, just to obtain the property, but for you to just
> take the opportunity to initialize
> it for use, and leave it there until program exit. That should save resources
> overall.
> (BTW, CUDA contexts should be quite expensive to create/destroy, using a
> cuCtxCreate/Destroy pair is probably
> almost as slow)

 I have argued that this looks like a corner-case use case to me, as 
querying for the remaining (rather than total) memory available to a 
device that hasn't been (yet) used looks like of hardly any use to me, 
because obviously at such a stage no memory has been used.  The OpenACC 
standard does require us to handle such a request somehow, with returning 
0 being another option, however I thought we may well have a quick peek 
without pulling in all the state.

 I guess I have no strong opinion either way and I can adapt accordingly.

 NB that would have to be `gomp_init_device' rather than 
`GOMP_OFFLOAD_init_device' AFAICS.

  Maciej
Chung-Lin Tang Dec. 10, 2018, 9:05 a.m. UTC | #3 
On 2018/12/6 2:16 AM, Maciej W. Rozycki wrote:
>> AFAIK, things like strlen are already available in iso_c_binding, in forms
>> like "C_strlen".
>> Can you check again if that 'openacc_c_string' module is really necessary?
>   Any pointers please?
> 
>   I can't see `c_strlen' or any equivalent interface defined either in the
> Fortran 2003 language standard or in GCC documentation, and neither `grep'
> over the GCC tree shows anything relevant.  The `iso_c_binding' module
> defines only a bunch of procedures according to said documentation.  The
> `strlen' function provided here has been taken from one of our Fortran
> test cases, which strongly indicates there's no such API already available
> or whoever wrote the test case would have chosen to use it I suppose.

Okay I see. I think I mixed up the common convention with the actual interface
standard.

>>> +	    CUcontext new_ctx;
>>> +
>>> +	    CUDA_CALL_ERET (propval, cuCtxCreate, &new_ctx, CU_CTX_SCHED_AUTO,
>>> +			    dev);
>>> +	    CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
>>> +	    CUDA_CALL_ASSERT (cuCtxDestroy, new_ctx);
>>> +	  }
>> (I'm CCing Tom here, as he is maintainer for these parts)
>>
>> As we discussed earlier on our internal list, I think properly using
>> GOMP_OFFLOAD_init_device
>> is the right way, instead of using the lower level CUDA context
>> create/destroy.
>>
>> I did not mean for you to first init the device and then immediately destroy
>> it by
>> GOMP_OFFLOAD_fini_device, just to obtain the property, but for you to just
>> take the opportunity to initialize
>> it for use, and leave it there until program exit. That should save resources
>> overall.
>> (BTW, CUDA contexts should be quite expensive to create/destroy, using a
>> cuCtxCreate/Destroy pair is probably
>> almost as slow)
>   I have argued that this looks like a corner-case use case to me, as
> querying for the remaining (rather than total) memory available to a
> device that hasn't been (yet) used looks like of hardly any use to me,
> because obviously at such a stage no memory has been used.  The OpenACC
> standard does require us to handle such a request somehow, with returning
> 0 being another option, however I thought we may well have a quick peek
> without pulling in all the state.
> 
>   I guess I have no strong opinion either way and I can adapt accordingly.
> 
>   NB that would have to be `gomp_init_device' rather than
> `GOMP_OFFLOAD_init_device' AFAICS.

You'll have to use GOMP_OFFLOAD_init_device, as you are inside the plugin, gomp_init_device()
should not be available.

However, looking into this further, the checking conventions of GOMP_OFFLOAD_init_device
will have to be slightly tweaked to accommodate possible further initing from libgomp proper,
so this may requirement a longer string of changes...I think it's not worth it, or can
be adjusted later. I now think your current approach with the CUDA contexts is okay.

I think the patch is okay, although still needs approval from Thomas and Tom to commit.

Thanks,
Chung-Lin
Maciej W. Rozycki Dec. 20, 2018, 2:20 p.m. UTC | #4 
On Mon, 10 Dec 2018, Chung-Lin Tang wrote:

> I think the patch is okay, although still needs approval from Thomas and Tom
> to commit.

 I have committed this change now, thank you for your review.

  Maciej
Thomas Schwinge Jan. 8, 2019, 5:42 p.m. UTC | #5 
Hi Maciej!

On Mon, 3 Dec 2018 16:51:14 +0000, "Maciej W. Rozycki" <macro@codesourcery.com> wrote:
> Add generic support for the OpenACC 2.6 `acc_get_property' and 
> `acc_get_property_string' routines, as well as full handlers for the 
> host and the NVPTX offload targets and a minimal handler for the HSA 
> offload target.

..., but a similar minimal handler for the Intel MIC offload plugin
missing.  ;-) (... which "for reasons" doesn't live in "libgomp/plugin/",
next to the other plugins.)

To fix that, I pushed the attached to openacc-gcc-8-branch, with the code
copied and adjusted from your minimal handler for the HSA offload target,
but also with an additional TODO added.


Grüße
 Thomas
From c632bd83096f1a4e4ed59161797087ff800e4c23 Mon Sep 17 00:00:00 2001
From: Thomas Schwinge <thomas@codesourcery.com>
Date: Tue, 8 Jan 2019 15:21:35 +0100
Subject: [PATCH] Add OpenACC 2.6 `acc_get_property' support: restore Intel MIC
 offloading

The "OpenACC 2.6 `acc_get_property' support" changes regressed the relevant
libgomp OpenMP execution test cases to no longer consider Intel MIC offloading
because of:

    libgomp: while loading libgomp-plugin-intelmic.so.1: [...]/libgomp-plugin-intelmic.so.1: undefined symbol: GOMP_OFFLOAD_get_property

	liboffloadmic/
	* plugin/libgomp-plugin-intelmic.cpp (GOMP_OFFLOAD_get_property):
	New function.
---
 liboffloadmic/ChangeLog.openacc               | 10 +++++++++
 .../plugin/libgomp-plugin-intelmic.cpp        | 21 +++++++++++++++++++
 2 files changed, 31 insertions(+)
 create mode 100644 liboffloadmic/ChangeLog.openacc

diff --git a/liboffloadmic/ChangeLog.openacc b/liboffloadmic/ChangeLog.openacc
new file mode 100644
index 000000000000..2e666da2ce0c
--- /dev/null
+++ b/liboffloadmic/ChangeLog.openacc
@@ -0,0 +1,10 @@
+2019-01-08  Thomas Schwinge  <thomas@codesourcery.com>
+
+	* plugin/libgomp-plugin-intelmic.cpp (GOMP_OFFLOAD_get_property):
+	New function.
+
+Copyright (C) 2019 Free Software Foundation, Inc.
+
+Copying and distribution of this file, with or without modification,
+are permitted in any medium without royalty provided the copyright
+notice and this notice are preserved.
diff --git a/liboffloadmic/plugin/libgomp-plugin-intelmic.cpp b/liboffloadmic/plugin/libgomp-plugin-intelmic.cpp
index d1678d0514e9..f74941c2b549 100644
--- a/liboffloadmic/plugin/libgomp-plugin-intelmic.cpp
+++ b/liboffloadmic/plugin/libgomp-plugin-intelmic.cpp
@@ -174,6 +174,27 @@ GOMP_OFFLOAD_get_num_devices (void)
   return num_devices;
 }
 
+extern "C" union gomp_device_property_value
+GOMP_OFFLOAD_get_property (int n, int prop)
+{
+  union gomp_device_property_value nullval = { .val = 0 };
+
+  if (n >= num_devices)
+    {
+      GOMP_PLUGIN_error
+	("Request for a property of a non-existing Intel MIC device %i", n);
+      return nullval;
+    }
+
+  switch (prop)
+    {
+    case GOMP_DEVICE_PROPERTY_VENDOR:
+      return (union gomp_device_property_value) { .ptr = /* TODO: "error: invalid conversion from 'const void*' to 'void*' [-fpermissive]" */ (char *) "Intel" };
+    default:
+      return nullval;
+    }
+}
+
 static bool
 offload (const char *file, uint64_t line, int device, const char *name,
 	 int num_vars, VarDesc *vars, const void **async_data)
diff mbox series

Patch

Index: gcc-openacc-gcc-8-branch/include/gomp-constants.h
===================================================================
--- gcc-openacc-gcc-8-branch.orig/include/gomp-constants.h
+++ gcc-openacc-gcc-8-branch/include/gomp-constants.h
@@ -215,10 +215,24 @@  enum gomp_map_kind
 #define GOMP_DEVICE_NVIDIA_PTX		5
 #define GOMP_DEVICE_INTEL_MIC		6
 #define GOMP_DEVICE_HSA			7
+#define GOMP_DEVICE_CURRENT		8
 
 #define GOMP_DEVICE_ICV			-1
 #define GOMP_DEVICE_HOST_FALLBACK	-2
 
+/* Device property codes.  Keep in sync with
+   libgomp/{openacc.h,openacc.f90,openacc_lib.h}:acc_device_property_t
+   as well as libgomp/libgomp-plugin.h.  */
+/* Start from 1 to catch uninitialized use.  */
+#define GOMP_DEVICE_PROPERTY_MEMORY		1
+#define GOMP_DEVICE_PROPERTY_FREE_MEMORY	2
+#define GOMP_DEVICE_PROPERTY_NAME		0x10001
+#define GOMP_DEVICE_PROPERTY_VENDOR		0x10002
+#define GOMP_DEVICE_PROPERTY_DRIVER		0x10003
+
+/* Internal property mask to tell numeric and string values apart.  */
+#define GOMP_DEVICE_PROPERTY_STRING_MASK	0x10000
+
 /* GOMP_task/GOMP_taskloop* flags argument.  */
 #define GOMP_TASK_FLAG_UNTIED		(1 << 0)
 #define GOMP_TASK_FLAG_FINAL		(1 << 1)
Index: gcc-openacc-gcc-8-branch/libgomp/libgomp-plugin.h
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/libgomp-plugin.h
+++ gcc-openacc-gcc-8-branch/libgomp/libgomp-plugin.h
@@ -55,6 +55,13 @@  enum offload_target_type
   OFFLOAD_TARGET_TYPE_HSA = 7
 };
 
+/* Container type for passing device properties.  */
+union gomp_device_property_value
+{
+  void *ptr;
+  uintmax_t val;
+};
+
 /* Opaque type to represent plugin-dependent implementation of an
    OpenACC asynchronous queue.  */
 struct goacc_asyncqueue;  
@@ -99,6 +106,7 @@  extern const char *GOMP_OFFLOAD_get_name
 extern unsigned int GOMP_OFFLOAD_get_caps (void);
 extern int GOMP_OFFLOAD_get_type (void);
 extern int GOMP_OFFLOAD_get_num_devices (void);
+extern union gomp_device_property_value GOMP_OFFLOAD_get_property (int, int);
 extern bool GOMP_OFFLOAD_init_device (int);
 extern bool GOMP_OFFLOAD_fini_device (int);
 extern unsigned GOMP_OFFLOAD_version (void);
Index: gcc-openacc-gcc-8-branch/libgomp/libgomp.h
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/libgomp.h
+++ gcc-openacc-gcc-8-branch/libgomp/libgomp.h
@@ -988,6 +988,7 @@  struct gomp_device_descr
   __typeof (GOMP_OFFLOAD_get_caps) *get_caps_func;
   __typeof (GOMP_OFFLOAD_get_type) *get_type_func;
   __typeof (GOMP_OFFLOAD_get_num_devices) *get_num_devices_func;
+  __typeof (GOMP_OFFLOAD_get_property) *get_property_func;
   __typeof (GOMP_OFFLOAD_init_device) *init_device_func;
   __typeof (GOMP_OFFLOAD_fini_device) *fini_device_func;
   __typeof (GOMP_OFFLOAD_version) *version_func;
Index: gcc-openacc-gcc-8-branch/libgomp/libgomp.map
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/libgomp.map
+++ gcc-openacc-gcc-8-branch/libgomp/libgomp.map
@@ -442,6 +442,10 @@  OACC_2.5 {
 
 OACC_2.6 {
   global:
+	acc_get_property;
+	acc_get_property_h_;
+	acc_get_property_string;
+	acc_get_property_string_h_;
 	acc_attach;
 	acc_attach_async;
 	acc_detach;
Index: gcc-openacc-gcc-8-branch/libgomp/libgomp.texi
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/libgomp.texi
+++ gcc-openacc-gcc-8-branch/libgomp/libgomp.texi
@@ -1867,6 +1867,7 @@  version 2.5.
 * acc_get_device_type::         Get type of device accelerator to be used.
 * acc_set_device_num::          Set device number to use.
 * acc_get_device_num::          Get device number to be used.
+* acc_get_property::            Get device property.
 * acc_async_test::              Tests for completion of a specific asynchronous
                                 operation.
 * acc_async_test_all::          Tests for completion of all asychronous
@@ -2049,6 +2050,44 @@  region.
 
 
 
+@node acc_get_property
+@section @code{acc_get_property} -- Get device property.
+@cindex acc_get_property
+@cindex acc_get_property_string
+@table @asis
+@item @emph{Description}
+These routines return the value of the specified @var{property} for the
+device being queried according to @var{devicenum} and @var{devicetype}.
+Integer-valued and string-valued properties are returned by
+@code{acc_get_property} and @code{acc_get_property_string} respectively.
+The Fortran @code{acc_get_property_string} subroutine returns the string
+retrieved in its fourth argument while the remaining entry points are
+functions, which pass the return value as their result.
+
+@item @emph{C/C++}:
+@multitable @columnfractions .20 .80
+@item @emph{Prototype}: @tab @code{size_t acc_get_property(int devicenum, acc_device_t devicetype, acc_device_property_t property);}
+@item @emph{Prototype}: @tab @code{const char *acc_get_property_string(int devicenum, acc_device_t devicetype, acc_device_property_t property);}
+@end multitable
+
+@item @emph{Fortran}:
+@multitable @columnfractions .20 .80
+@item @emph{Interface}: @tab @code{function acc_get_property(devicenum, devicetype, property)}
+@item @emph{Interface}: @tab @code{subroutine acc_get_property_string(devicenum, devicetype, property, string)}
+@item                   @tab @code{integer devicenum}
+@item                   @tab @code{integer(kind=acc_device_kind) devicetype}
+@item                   @tab @code{integer(kind=acc_device_property) property}
+@item                   @tab @code{integer(kind=acc_device_property) acc_get_property}
+@item                   @tab @code{character(*) string}
+@end multitable
+
+@item @emph{Reference}:
+@uref{https://www.openacc.org, OpenACC specification v2.6}, section
+3.2.6.
+@end table
+
+
+
 @node acc_async_test
 @section @code{acc_async_test} -- Test for completion of a specific asynchronous operation.
 @table @asis
Index: gcc-openacc-gcc-8-branch/libgomp/oacc-host.c
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/oacc-host.c
+++ gcc-openacc-gcc-8-branch/libgomp/oacc-host.c
@@ -60,6 +60,27 @@  host_get_num_devices (void)
   return 1;
 }
 
+static union gomp_device_property_value
+host_get_property (int n, int prop)
+{
+  union gomp_device_property_value nullval = { .val = 0 };
+
+  if (n >= host_get_num_devices ())
+    return nullval;
+
+  switch (prop)
+    {
+    case GOMP_DEVICE_PROPERTY_NAME:
+      return (union gomp_device_property_value) { .ptr = "GOMP" };
+    case GOMP_DEVICE_PROPERTY_VENDOR:
+      return (union gomp_device_property_value) { .ptr = "GNU" };
+    case GOMP_DEVICE_PROPERTY_DRIVER:
+      return (union gomp_device_property_value) { .ptr = VERSION };
+    default:
+      return nullval;
+    }
+}
+
 static bool
 host_init_device (int n __attribute__ ((unused)))
 {
@@ -270,6 +291,7 @@  static struct gomp_device_descr host_dis
     .get_caps_func = host_get_caps,
     .get_type_func = host_get_type,
     .get_num_devices_func = host_get_num_devices,
+    .get_property_func = host_get_property,
     .init_device_func = host_init_device,
     .fini_device_func = host_fini_device,
     .version_func = host_version,
Index: gcc-openacc-gcc-8-branch/libgomp/oacc-init.c
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/oacc-init.c
+++ gcc-openacc-gcc-8-branch/libgomp/oacc-init.c
@@ -717,7 +717,8 @@  acc_get_device_type (void)
     }
 
   assert (res != acc_device_default
-	  && res != acc_device_not_host);
+	  && res != acc_device_not_host
+	  && res != acc_device_current);
 
   return res;
 }
@@ -826,6 +827,102 @@  acc_set_device_num (int ord, acc_device_
 
 ialias (acc_set_device_num)
 
+static union gomp_device_property_value
+get_property_any (int ord, acc_device_t d, acc_device_property_t prop)
+{
+  union gomp_device_property_value propval;
+  struct gomp_device_descr *dev;
+  struct goacc_thread *thr;
+
+  if (d == acc_device_none)
+    return (union gomp_device_property_value) { .val = 0 };
+
+  goacc_lazy_initialize ();
+  thr = goacc_thread ();
+
+  if (d == acc_device_current && (!thr || !thr->dev))
+    return (union gomp_device_property_value) { .val = 0 };
+
+  acc_prof_info prof_info;
+  acc_api_info api_info;
+  bool profiling_setup_p
+    = __builtin_expect (goacc_profiling_setup_p (thr, &prof_info, &api_info),
+			false);
+
+  if (d == acc_device_current)
+    {
+      if (profiling_setup_p)
+	{
+	  prof_info.device_type = acc_device_type (thr->dev->type);
+	  prof_info.device_number = thr->dev->target_id;
+	}
+
+      dev = thr->dev;
+    }
+  else
+    {
+      int num_devices;
+
+      if (profiling_setup_p)
+	{
+	  prof_info.device_type = d;
+	  prof_info.device_number = ord;
+	}
+
+      gomp_mutex_lock (&acc_device_lock);
+
+      dev = resolve_device (d, false);
+
+      num_devices = dev->get_num_devices_func ();
+
+      if (num_devices <= 0 || ord >= num_devices)
+        acc_dev_num_out_of_range (d, ord, num_devices);
+
+      dev += ord;
+
+      gomp_mutex_lock (&dev->lock);
+      if (dev->state == GOMP_DEVICE_UNINITIALIZED)
+        gomp_init_device (dev);
+      gomp_mutex_unlock (&dev->lock);
+
+      gomp_mutex_unlock (&acc_device_lock);
+    }
+
+  assert (dev);
+
+  propval = dev->get_property_func (dev->target_id, prop);
+
+  if (profiling_setup_p)
+    {
+      thr->prof_info = NULL;
+      thr->api_info = NULL;
+    }
+
+  return propval;
+}
+
+size_t
+acc_get_property (int ord, acc_device_t d, acc_device_property_t prop)
+{
+  if (prop & GOMP_DEVICE_PROPERTY_STRING_MASK)
+    return 0;
+  else
+    return get_property_any (ord, d, prop).val;
+}
+
+ialias (acc_get_property)
+
+const char *
+acc_get_property_string (int ord, acc_device_t d, acc_device_property_t prop)
+{
+  if (prop & GOMP_DEVICE_PROPERTY_STRING_MASK)
+    return get_property_any (ord, d, prop).ptr;
+  else
+    return NULL;
+}
+
+ialias (acc_get_property_string)
+
 /* For -O and higher, the compiler always attempts to expand acc_on_device, but
    if the user disables the builtin, or calls it via a pointer, we'll need this
    version.
Index: gcc-openacc-gcc-8-branch/libgomp/openacc.f90
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/openacc.f90
+++ gcc-openacc-gcc-8-branch/libgomp/openacc.f90
@@ -28,7 +28,7 @@ 
 !  <http://www.gnu.org/licenses/>.
 
 module openacc_kinds
-  use iso_fortran_env, only: int32
+  use iso_fortran_env, only: int32, int64
   implicit none
 
   private :: int32
@@ -46,6 +46,21 @@  module openacc_kinds
   ! integer (acc_device_kind), parameter :: acc_device_host_nonshm = 3 removed.
   integer (acc_device_kind), parameter :: acc_device_not_host = 4
   integer (acc_device_kind), parameter :: acc_device_nvidia = 5
+  integer (acc_device_kind), parameter :: acc_device_current = 8
+
+  public :: acc_device_property
+
+  integer, parameter :: acc_device_property = int64
+
+  public :: acc_property_memory, acc_property_free_memory
+  public :: acc_property_name, acc_property_vendor, acc_property_driver
+
+  ! Keep in sync with include/gomp-constants.h.
+  integer (acc_device_property), parameter :: acc_property_memory = 1
+  integer (acc_device_property), parameter :: acc_property_free_memory = 2
+  integer (acc_device_property), parameter :: acc_property_name = Z'10001'
+  integer (acc_device_property), parameter :: acc_property_vendor = Z'10002'
+  integer (acc_device_property), parameter :: acc_property_driver = Z'10003'
 
   public :: acc_handle_kind
 
@@ -93,6 +108,22 @@  module openacc_internal
       integer (acc_device_kind) d
     end function
 
+    function acc_get_property_h (n, d, p)
+      import
+      integer (acc_device_property) :: acc_get_property_h
+      integer, value :: n
+      integer (acc_device_kind), value :: d
+      integer (acc_device_property), value :: p
+    end function
+
+    subroutine acc_get_property_string_h (n, d, p, s)
+      import
+      integer, value :: n
+      integer (acc_device_kind), value :: d
+      integer (acc_device_property), value :: p
+      character (*) :: s
+    end subroutine
+
     subroutine acc_set_default_async_h (a)
       import
       integer a
@@ -570,6 +601,24 @@  module openacc_internal
       integer (c_int), value :: d
     end function
 
+    function acc_get_property_l (n, d, p) &
+        bind (C, name = "acc_get_property")
+      use iso_c_binding, only: c_int, c_size_t
+      integer (c_size_t) :: acc_get_property_l
+      integer (c_int), value :: n
+      integer (c_int), value :: d
+      integer (c_int), value :: p
+    end function
+
+    function acc_get_property_string_l (n, d, p) &
+        bind (C, name = "acc_get_property_string")
+      use iso_c_binding, only: c_int, c_ptr
+      type (c_ptr) :: acc_get_property_string_l
+      integer (c_int), value :: n
+      integer (c_int), value :: d
+      integer (c_int), value :: p
+    end function
+
     function acc_async_test_l (a) &
         bind (C, name = "acc_async_test")
       use iso_c_binding, only: c_int
@@ -830,6 +879,14 @@  module openacc
     procedure :: acc_get_device_num_h
   end interface
 
+  interface acc_get_property
+    procedure :: acc_get_property_h
+  end interface
+
+  interface acc_get_property_string
+    procedure :: acc_get_property_string_h
+  end interface
+
   interface acc_set_default_async
     procedure :: acc_set_default_async_h
   end interface
@@ -1030,6 +1087,19 @@  module openacc
 
 end module
 
+module openacc_c_string
+  implicit none
+
+  interface
+    function strlen (s) bind (C, name = "strlen")
+      use iso_c_binding, only: c_ptr, c_size_t
+      type (c_ptr), intent(in), value :: s
+      integer (c_size_t) :: strlen
+    end function
+  end interface
+
+end module
+
 function acc_get_num_devices_h (d)
   use openacc_internal, only: acc_get_num_devices_l
   use openacc_kinds
@@ -1068,6 +1138,50 @@  function acc_get_device_num_h (d)
   acc_get_device_num_h = acc_get_device_num_l (d)
 end function
 
+function acc_get_property_h (n, d, p)
+  use iso_c_binding, only: c_int
+  use openacc_internal, only: acc_get_property_l
+  use openacc_kinds
+  integer (acc_device_property) :: acc_get_property_h
+  integer, value :: n
+  integer (acc_device_kind), value :: d
+  integer (acc_device_property), value :: p
+
+  integer (c_int) :: pint
+
+  pint = int (p, c_int)
+  acc_get_property_h = acc_get_property_l (n, d, pint)
+end function
+
+subroutine acc_get_property_string_h (n, d, p, s)
+  use iso_c_binding, only: c_char, c_int, c_ptr, c_f_pointer
+  use openacc_internal, only: acc_get_property_string_l
+  use openacc_c_string, only: strlen
+  use openacc_kinds
+  integer, value :: n
+  integer (acc_device_kind), value :: d
+  integer (acc_device_property), value :: p
+  character (*) :: s
+
+  integer (c_int) :: pint
+  type (c_ptr) :: cptr
+  integer :: clen
+  character (kind=c_char, len=1), pointer :: sptr (:)
+  integer :: slen
+  integer :: i
+
+  pint = int (p, c_int)
+  cptr = acc_get_property_string_l (n, d, pint)
+  clen = int (strlen (cptr))
+  call c_f_pointer (cptr, sptr, [clen])
+
+  s = ""
+  slen = min (clen, len (s))
+  do i = 1, slen
+    s (i:i) = sptr (i)
+  end do
+end subroutine
+
 function acc_async_test_h (a)
   use openacc_internal, only: acc_async_test_l
   logical acc_async_test_h
Index: gcc-openacc-gcc-8-branch/libgomp/openacc.h
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/openacc.h
+++ gcc-openacc-gcc-8-branch/libgomp/openacc.h
@@ -57,12 +57,23 @@  typedef enum acc_device_t {
   acc_device_nvidia = 5,
   /* not supported */ _acc_device_intel_mic = 6,
   /* not supported */ _acc_device_hsa = 7,
+  acc_device_current = 8,
   _ACC_device_hwm,
   /* Ensure enumeration is layout compatible with int.  */
   _ACC_highest = __INT_MAX__,
   _ACC_neg = -1
 } acc_device_t;
 
+typedef enum acc_device_property_t {
+  /* Keep in sync with include/gomp-constants.h.  */
+  /* Start from 1 to catch uninitialized use.  */
+  acc_property_memory = 1,
+  acc_property_free_memory = 2,
+  acc_property_name = 0x10001,
+  acc_property_vendor = 0x10002,
+  acc_property_driver = 0x10003
+} acc_device_property_t;
+
 typedef enum acc_async_t {
   /* Keep in sync with include/gomp-constants.h.  */
   acc_async_default = 0,
@@ -75,6 +86,10 @@  void acc_set_device_type (acc_device_t) 
 acc_device_t acc_get_device_type (void) __GOACC_NOTHROW;
 void acc_set_device_num (int, acc_device_t) __GOACC_NOTHROW;
 int acc_get_device_num (acc_device_t) __GOACC_NOTHROW;
+size_t acc_get_property
+  (int, acc_device_t, acc_device_property_t) __GOACC_NOTHROW;
+const char *acc_get_property_string
+  (int, acc_device_t, acc_device_property_t) __GOACC_NOTHROW;
 void acc_set_default_async (int) __GOACC_NOTHROW;
 int acc_get_default_async (void) __GOACC_NOTHROW;
 int acc_async_test (int) __GOACC_NOTHROW;
Index: gcc-openacc-gcc-8-branch/libgomp/plugin/plugin-hsa.c
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/plugin/plugin-hsa.c
+++ gcc-openacc-gcc-8-branch/libgomp/plugin/plugin-hsa.c
@@ -689,6 +689,32 @@  GOMP_OFFLOAD_get_num_devices (void)
   return hsa_context.agent_count;
 }
 
+/* Part of the libgomp plugin interface.  Return the value of property
+   PROP of agent number N.  */
+
+union gomp_device_property_value
+GOMP_OFFLOAD_get_property (int n, int prop)
+{
+  union gomp_device_property_value nullval = { .val = 0 };
+
+  if (!init_hsa_context ())
+    return nullval;
+  if (n >= hsa_context.agent_count)
+    {
+      GOMP_PLUGIN_error
+	("Request for a property of a non-existing HSA device %i", n);
+      return nullval;
+    }
+
+  switch (prop)
+    {
+    case GOMP_DEVICE_PROPERTY_VENDOR:
+      return (union gomp_device_property_value) { .ptr = "AMD" };
+    default:
+      return nullval;
+    }
+}
+
 /* Part of the libgomp plugin interface.  Initialize agent number N so that it
    can be used for computation.  Return TRUE on success.  */
 
Index: gcc-openacc-gcc-8-branch/libgomp/plugin/plugin-nvptx.c
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/plugin/plugin-nvptx.c
+++ gcc-openacc-gcc-8-branch/libgomp/plugin/plugin-nvptx.c
@@ -63,6 +63,9 @@  CUDA_ONE_CALL (cuCtxSynchronize)	\
 CUDA_ONE_CALL (cuDeviceGet)		\
 CUDA_ONE_CALL (cuDeviceGetAttribute)	\
 CUDA_ONE_CALL (cuDeviceGetCount)	\
+CUDA_ONE_CALL (cuDeviceGetName)		\
+CUDA_ONE_CALL (cuDeviceTotalMem)	\
+CUDA_ONE_CALL (cuDriverGetVersion)	\
 CUDA_ONE_CALL (cuEventCreate)		\
 CUDA_ONE_CALL (cuEventDestroy)		\
 CUDA_ONE_CALL (cuEventElapsedTime)	\
@@ -88,6 +91,7 @@  CUDA_ONE_CALL (cuMemcpyHtoDAsync)	\
 CUDA_ONE_CALL (cuMemFree)		\
 CUDA_ONE_CALL (cuMemFreeHost)		\
 CUDA_ONE_CALL (cuMemGetAddressRange)	\
+CUDA_ONE_CALL (cuMemGetInfo)		\
 CUDA_ONE_CALL (cuMemHostGetDevicePointer)\
 CUDA_ONE_CALL (cuModuleGetFunction)	\
 CUDA_ONE_CALL (cuModuleGetGlobal)	\
@@ -1014,6 +1018,93 @@  GOMP_OFFLOAD_get_num_devices (void)
   return nvptx_get_num_devices ();
 }
 
+union gomp_device_property_value
+GOMP_OFFLOAD_get_property (int n, int prop)
+{
+  union gomp_device_property_value propval = { .val = 0 };
+
+  pthread_mutex_lock (&ptx_dev_lock);
+
+  if (!nvptx_init () || n >= nvptx_get_num_devices ())
+    {
+      pthread_mutex_unlock (&ptx_dev_lock);
+      return propval;
+    }
+
+  switch (prop)
+    {
+    case GOMP_DEVICE_PROPERTY_MEMORY:
+      {
+	size_t total_mem;
+	CUdevice dev;
+
+	CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
+	CUDA_CALL_ERET (propval, cuDeviceTotalMem, &total_mem, dev);
+	propval.val = total_mem;
+      }
+      break;
+    case GOMP_DEVICE_PROPERTY_FREE_MEMORY:
+      {
+	size_t total_mem;
+	size_t free_mem;
+	CUdevice ctxdev;
+	CUdevice dev;
+
+	CUDA_CALL_ERET (propval, cuCtxGetDevice, &ctxdev);
+	CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
+	if (dev == ctxdev)
+	  CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
+	else if (ptx_devices[n])
+	  {
+	    CUcontext old_ctx;
+
+	    CUDA_CALL_ERET (propval, cuCtxPushCurrent, ptx_devices[n]->ctx);
+	    CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
+	    CUDA_CALL_ASSERT (cuCtxPopCurrent, &old_ctx);
+	  }
+	else
+	  {
+	    CUcontext new_ctx;
+
+	    CUDA_CALL_ERET (propval, cuCtxCreate, &new_ctx, CU_CTX_SCHED_AUTO,
+			    dev);
+	    CUDA_CALL_ERET (propval, cuMemGetInfo, &free_mem, &total_mem);
+	    CUDA_CALL_ASSERT (cuCtxDestroy, new_ctx);
+	  }
+	propval.val = free_mem;
+      }
+      break;
+    case GOMP_DEVICE_PROPERTY_NAME:
+      {
+	static char name[256];
+	CUdevice dev;
+
+	CUDA_CALL_ERET (propval, cuDeviceGet, &dev, n);
+	CUDA_CALL_ERET (propval, cuDeviceGetName, name, sizeof (name), dev);
+	propval.ptr = name;
+      }
+      break;
+    case GOMP_DEVICE_PROPERTY_VENDOR:
+      propval.ptr = "Nvidia";
+      break;
+    case GOMP_DEVICE_PROPERTY_DRIVER:
+      {
+	static char ver[11];
+	int v;
+
+	CUDA_CALL_ERET (propval, cuDriverGetVersion, &v);
+	snprintf (ver, sizeof (ver) - 1, "%u.%u", v / 1000, v % 1000 / 10);
+	propval.ptr = ver;
+      }
+      break;
+    default:
+      break;
+    }
+
+  pthread_mutex_unlock (&ptx_dev_lock);
+  return propval;
+}
+
 bool
 GOMP_OFFLOAD_init_device (int n)
 {
Index: gcc-openacc-gcc-8-branch/libgomp/target.c
===================================================================
--- gcc-openacc-gcc-8-branch.orig/libgomp/target.c
+++ gcc-openacc-gcc-8-branch/libgomp/target.c
@@ -3477,6 +3477,7 @@  gomp_load_plugin_for_device (struct gomp
   DLSYM (get_caps);
   DLSYM (get_type);
   DLSYM (get_num_devices);
+  DLSYM (get_property);
   DLSYM (init_device);
   DLSYM (fini_device);
   DLSYM (load_image);
Index: gcc-openacc-gcc-8-branch/libgomp/testsuite/libgomp.oacc-c-c++-common/acc-get-property.c
===================================================================
--- /dev/null
+++ gcc-openacc-gcc-8-branch/libgomp/testsuite/libgomp.oacc-c-c++-common/acc-get-property.c
@@ -0,0 +1,37 @@ 
+/* Test the `acc_get_property' and '`acc_get_property_string' library
+   functions. */
+/* { dg-do run } */
+
+#include <openacc.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+
+int main ()
+{
+  const char *s;
+  size_t v;
+  int r;
+
+  /* Verify that the vendor is a proper non-empty string.  */
+  s = acc_get_property_string (0, acc_device_default, acc_property_vendor);
+  r = !s || !strlen (s);
+  if (s)
+    printf ("OpenACC vendor: %s\n", s);
+
+  /* For the rest just check that they do not crash.  */
+  v = acc_get_property (0, acc_device_default, acc_property_memory);
+  if (v)
+    printf ("OpenACC total memory: %zd\n", v);
+  v = acc_get_property (0, acc_device_default, acc_property_free_memory);
+  if (v)
+    printf ("OpenACC free memory: %zd\n", v);
+  s = acc_get_property_string (0, acc_device_default, acc_property_name);
+  if (s)
+    printf ("OpenACC name: %s\n", s);
+  s = acc_get_property_string (0, acc_device_default, acc_property_driver);
+  if (s)
+    printf ("OpenACC driver: %s\n", s);
+
+  return r;
+}
Index: gcc-openacc-gcc-8-branch/libgomp/testsuite/libgomp.oacc-fortran/acc-get-property.f
===================================================================
--- /dev/null
+++ gcc-openacc-gcc-8-branch/libgomp/testsuite/libgomp.oacc-fortran/acc-get-property.f
@@ -0,0 +1,33 @@ 
+! Test the `acc_get_property' and '`acc_get_property_string' library
+! functions.
+! { dg-do run }
+
+      USE OPENACC
+      IMPLICIT NONE
+
+      INTEGER(ACC_DEVICE_PROPERTY) V
+      CHARACTER*256 S
+      LOGICAL R
+
+      ! Verify that the vendor is a non-empty string.
+      CALL ACC_GET_PROPERTY_STRING (0, ACC_DEVICE_DEFAULT,
+     +                              ACC_PROPERTY_VENDOR, S)
+      R = S /= ""
+      IF (S /= "") PRINT "(A, A)", "OpenACC vendor: ", TRIM (S)
+
+      ! For the rest just check that they do not crash.
+      V = ACC_GET_PROPERTY (0, ACC_DEVICE_DEFAULT,
+     +                      ACC_PROPERTY_MEMORY)
+      IF (V /= 0) PRINT "(A, I0)", "OpenACC total memory: ", V
+      V = ACC_GET_PROPERTY (0, ACC_DEVICE_DEFAULT,
+     +                      ACC_PROPERTY_FREE_MEMORY)
+      IF (V /= 0) PRINT "(A, I0)", "OpenACC free memory: ", V
+      CALL ACC_GET_PROPERTY_STRING (0, ACC_DEVICE_DEFAULT,
+     +                              ACC_PROPERTY_NAME, S)
+      IF (S /= "") PRINT "(A, A)", "OpenACC name: ", TRIM (S)
+      CALL ACC_GET_PROPERTY_STRING (0, ACC_DEVICE_DEFAULT,
+     +                              ACC_PROPERTY_DRIVER, S)
+      IF (S /= "") PRINT "(A, A)", "OpenACC driver: ", TRIM (S)
+
+      IF (.NOT. R) STOP 1
+      END