diff mbox series

[OpenMP,Fortran] Support absent optional args with use_device_{ptr,addr} (+ OpenACC's use_device clause)

Message ID 1927b111-292c-4586-6052-feee72099ab1@codesourcery.com
State New
Headers show
Series [OpenMP,Fortran] Support absent optional args with use_device_{ptr,addr} (+ OpenACC's use_device clause) | expand

Commit Message

Tobias Burnus Nov. 6, 2019, 3:04 p.m. UTC
This patch is based on Kwok's patch, posted as (4/5) at 
https://gcc.gnu.org/ml/gcc-patches/2019-07/msg00964.html – which is 
targeting OpenACC's use_device* – but it also applies to OpenMP 
use_device_{ptr,addr}.

I added an OpenMP test case. It showed that for arguments with value 
attribute and for assumed-shape array, one needs to do more — as the 
decl cannot be directly used for the is-argument-present check.

(For 'value', a hidden boolean '_' + arg-name is passed in addition; for 
assumed-shape arrays, the array descriptor "x" is replaced by the local 
variable "x.0" (with "x.0 = x->data") and the original decl "x" is in 
GFC_DECL_SAVED_DESCRIPTOR. Especially for assumed-shape arrays, the new 
decl cannot be used unconditionally as it is uninitialized when the 
argument is absent.)

Bootstrapped and regtested on x86_64-gnu-linux without offloading + with 
nvptx.
OK?

Cheers,

Tobias

*The OpenACC test cases are in 5/5 and depend on some other changes. 
Submission of {1,missing one line of 2,3,5}/5 is planned next.
PPS: For fully absent-optional support, mapping needs to be handled for 
OpenACC (see Kwok's …/5 patches) and OpenMP (which is quite different on 
FE level) – and OpenMP also needs changes for the share clauses.]

Comments

Tobias Burnus Nov. 7, 2019, 10:42 a.m. UTC | #1
Thinking about the patch over night, I have now updated it a bit: 
Namely, I only add the "if(present-check)" condition, if the original 
variable is dereferenced. There is no need for code like

   omp_data_arr.c = c == NULL ? NULL : c;

and then, after the libgomp call, code like "c_2 = c == NULL ? NULL : 
omp_data_arr.c;"; due to the libgomp call, the latter cannot even be 
optimized away.

Hence, I added 'do_optional_check'; additionally, I had a 
libgomp.fortran/use_device_ptr-optional-1.f90 change floating around, 
which I included. Otherwise unchanged.

Retested. OK for the trunk?

Cheers,

Tobias

On 11/6/19 4:04 PM, Tobias Burnus wrote:

> This patch is based on Kwok's patch, posted as (4/5) at 
> https://gcc.gnu.org/ml/gcc-patches/2019-07/msg00964.html – which is 
> targeting OpenACC's use_device* – but it also applies to OpenMP 
> use_device_{ptr,addr}.
>
> I added an OpenMP test case. It showed that for arguments with value 
> attribute and for assumed-shape array, one needs to do more — as the 
> decl cannot be directly used for the is-argument-present check.
>
> (For 'value', a hidden boolean '_' + arg-name is passed in addition; 
> for assumed-shape arrays, the array descriptor "x" is replaced by the 
> local variable "x.0" (with "x.0 = x->data") and the original decl "x" 
> is in GFC_DECL_SAVED_DESCRIPTOR. Especially for assumed-shape arrays, 
> the new decl cannot be used unconditionally as it is uninitialized 
> when the argument is absent.)
>
> Bootstrapped and regtested on x86_64-gnu-linux without offloading + 
> with nvptx.
> OK?
>
> Cheers,
>
> Tobias
>
> *The OpenACC test cases are in 5/5 and depend on some other changes. 
> Submission of {1,missing one line of 2,3,5}/5 is planned next.
> PPS: For fully absent-optional support, mapping needs to be handled 
> for OpenACC (see Kwok's …/5 patches) and OpenMP (which is quite 
> different on FE level) – and OpenMP also needs changes for the share 
> clauses.]
>
Jakub Jelinek Nov. 8, 2019, 2:39 p.m. UTC | #2
On Thu, Nov 07, 2019 at 11:42:22AM +0100, Tobias Burnus wrote:
> +  /* For VALUE, the scalar variable is passed as is but a hidden argument
> +     denotes the value.  Cf. trans-expr.c.  */
> +  if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE)
> +    {
> +      char name[GFC_MAX_SYMBOL_LEN + 2];
> +      tree tree_name;
> +
> +      name[0] = '_';
> +      strcpy (&name[1], IDENTIFIER_POINTER (DECL_NAME (decl)));
> +      tree_name = get_identifier (name);
> +
> +      /* Walk function argument list to find the hidden arg.  */
> +      decl = DECL_ARGUMENTS (DECL_CONTEXT (decl));
> +      for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
> +	if (DECL_NAME (decl) == tree_name)
> +	  break;
> +
> +      gcc_assert (decl);
> +      return decl;
> +    }

Is this reliable?  I mean, consider -fallow-leading-underscore with:
subroutine foo (a, _a)
  integer, optional, value :: a
  logical(kind=1), value :: _a
...
end subroutine foo
and whatever OpenMP clause is affected in ...
In GIMPLE dump I certainly see:
foo (integer(kind=4) a, logical(kind=1) _a, logical(kind=1) _a)
and I bet the above would pick the wrong one.

Not really sure if additional DECL_ARTIFICIAL (decl) test would be enough.

> --- a/gcc/omp-general.c
> +++ b/gcc/omp-general.c
> @@ -63,12 +63,18 @@ omp_is_allocatable_or_ptr (tree decl)
>    return lang_hooks.decls.omp_is_allocatable_or_ptr (decl);
>  }
>  
> -/* Return true if DECL is a Fortran optional argument.  */
> +/* Check whether this DECL belongs to a Fortran optional argument.
> +   With 'for_present_check' set to false, decls which are optional parameters
> +   themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
> +   always pointers.  With 'for_present_check' set to true, the decl for checking
> +   whether an argument is present is returned; for arguments with value
> +   attribute this is the hidden argument and of BOOLEAN_TYPE.  If the decl is
> +   unrelated to optional arguments, NULL_TREE is returned.  */
>  
> -bool
> -omp_is_optional_argument (tree decl)
> +tree
> +omp_check_optional_argument (tree decl, bool also_value)

Why is the argument called for_present_check in the langhook and
also_value here?  Looks inconsistent.

> --- a/gcc/omp-general.h
> +++ b/gcc/omp-general.h
> @@ -74,7 +74,7 @@ struct omp_for_data
>  
>  extern tree omp_find_clause (tree clauses, enum omp_clause_code kind);
>  extern bool omp_is_allocatable_or_ptr (tree decl);
> -extern bool omp_is_optional_argument (tree decl);
> +extern tree omp_check_optional_argument (tree decl, bool also_value);
>  extern bool omp_is_reference (tree decl);
>  extern void omp_adjust_for_condition (location_t loc, enum tree_code *cond_code,
>  				      tree *n2, tree v, tree step);

Here too.

	Jakub
Tobias Burnus Nov. 8, 2019, 3:41 p.m. UTC | #3
Hi Jakub,

thanks for the review.

On 11/8/19 3:39 PM, Jakub Jelinek wrote:
>> +      /* Walk function argument list to find the hidden arg.  */
>> +      decl = DECL_ARGUMENTS (DECL_CONTEXT (decl));
>> +      for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
>> +	if (DECL_NAME (decl) == tree_name)
>> +	  break;
> Is this reliable?  I mean, consider -fallow-leading-underscore with:
> subroutine foo (a, _a)

I also assume that this will break; unlikely in real-world code but still.

> Not really sure if additional DECL_ARTIFICIAL (decl) test would be enough.

At least, I cannot quickly come up with a case where it will break. – I 
have now added it; also to the existing trans-expr.c function – which 
uses the used and, hence, same algorithm.

>> +omp_check_optional_argument (tree decl, bool also_value)
> Why is the argument called for_present_check in the langhook and
> also_value here?  Looks inconsistent.

Because I initially was thinking only of the VALUE attribute until I 
realized that assumed-shape arrays have the same issue; they use a local 
variable for the data – and make the actual array descriptor available 
via lang-specific field. – As the use is either an extra deref is needed 
or a check whether the variable is present, I changed the meaning – 
seemingly, three places survived with the old name.

With DECL_ARTIFICIAL added and also_value replaced:
Build on x86-64-gnu-linux. OK once regtested?

Tobias
Jakub Jelinek Nov. 8, 2019, 3:54 p.m. UTC | #4
On Fri, Nov 08, 2019 at 04:41:23PM +0100, Tobias Burnus wrote:
> With DECL_ARTIFICIAL added and also_value replaced:
> Build on x86-64-gnu-linux. OK once regtested?

Almost.

> -	    gimplify_assign (x, var, &ilist);
> +	    if (do_optional_check && omp_check_optional_argument (ovar, true))
 
Do you need true here when just testing for non-NULL?
If yes, it would be better to call it just once, so that e.g. the
DECL_ARGUMENTS list is not walked twice.  So perhaps:

	    tree present;
	    present = (do_optional_check
		       ? omp_check_optional_argument (ovar, true) : NULL_TREE);
	    if (present)
	      {

> +	      {
> +		tree null_label = create_artificial_label (UNKNOWN_LOCATION);
> +		tree notnull_label = create_artificial_label (UNKNOWN_LOCATION);
> +		tree opt_arg_label = create_artificial_label (UNKNOWN_LOCATION);

I this this is already too long, so needs line wrapping before =.

> +		tree new_x = unshare_expr (x);
> +		tree present = omp_check_optional_argument (ovar, true);

And not call it here again.

> +		gimplify_expr (&present, &ilist, NULL, is_gimple_val,
> +			       fb_rvalue);
> +		gcond *cond = gimple_build_cond_from_tree (present,
> +							   notnull_label,
> +							   null_label);
> +		gimple_seq_add_stmt (&ilist, cond);
> +		gimple_seq_add_stmt (&ilist, gimple_build_label (null_label));
> +		gimplify_assign (new_x, null_pointer_node, &ilist);
> +		gimple_seq_add_stmt (&ilist, gimple_build_goto (opt_arg_label));

And here similarly.

> +	    if (do_optional_check
> +		&& omp_check_optional_argument (OMP_CLAUSE_DECL (c), true))
> +	      {
> +		tree null_label = create_artificial_label (UNKNOWN_LOCATION);
> +		tree notnull_label = create_artificial_label (UNKNOWN_LOCATION);
> +		tree opt_arg_label = create_artificial_label (UNKNOWN_LOCATION);
> +		glabel *null_glabel = gimple_build_label (null_label);
> +		glabel *notnull_glabel = gimple_build_label (notnull_label);
> +		ggoto *opt_arg_ggoto = gimple_build_goto (opt_arg_label);
> +		gimplify_expr (&x, &new_body, NULL, is_gimple_val,
> +					   fb_rvalue);
> +		tree present = omp_check_optional_argument (OMP_CLAUSE_DECL (c),
> +							    true);

Similarly to the above.

Otherwise LGTM.

	Jakub
Thomas Schwinge Nov. 11, 2019, 12:14 p.m. UTC | #5
Hi Tobias!

Thanks for looking into this mess ;-) of Fortran optional arguments
support for OMP, based on what Kwok has already developed.


On 2019-11-08T16:41:23+0100, Tobias Burnus <tobias@codesourcery.com> wrote:
> --- /dev/null
> +++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90

When adding '{ dg-do run }' for torture testing (please remember to), I
see the '-O0' and '-O1' execution testing FAIL, complaining that
"libgomp: use_device_ptr pointer wasn't mapped".


Grüße
 Thomas


> @@ -0,0 +1,33 @@
> +! Check whether absent optional arguments are properly
> +! handled with use_device_{addr,ptr}.
> +program main
> + implicit none (type, external)
> + call foo()
> +contains
> +  subroutine foo(v, w, x, y, z)
> +    integer, target, optional, value :: v
> +    integer, target, optional :: w
> +    integer, target, optional :: x(:)
> +    integer, target, optional, allocatable :: y
> +    integer, target, optional, allocatable :: z(:)
> +    integer :: d
> +
> +    !$omp target data map(d) use_device_addr(v, w, x, y, z)
> +      if(present(v)) stop 1
> +      if(present(w)) stop 2
> +      if(present(x)) stop 3
> +      if(present(y)) stop 4
> +      if(present(z)) stop 5
> +    !$omp end target data
> +
> +! Using 'v' in use_device_ptr gives an ICE
> +! TODO: Find out what the OpenMP spec permits for use_device_ptr
> +
> +    !$omp target data map(d) use_device_ptr(w, x, y, z)
> +      if(present(w)) stop 6
> +      if(present(x)) stop 7
> +      if(present(y)) stop 8
> +      if(present(z)) stop 9
> +    !$omp end target data
> +  end subroutine foo
> +end program main
Thomas Schwinge April 29, 2020, 8:03 a.m. UTC | #6
Hi!

On 2019-11-11T13:14:43+0100, I wrote:
> On 2019-11-08T16:41:23+0100, Tobias Burnus <tobias@codesourcery.com> wrote:
>> --- /dev/null
>> +++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
>
> When adding '{ dg-do run }' for torture testing (please remember to), I
> see the '-O0' and '-O1' execution testing FAIL, complaining that
> "libgomp: use_device_ptr pointer wasn't mapped".

That'd gotten resolved in the mean time, so I've now myself pushed to
master branch in commit b9dc11b6730a8030cfc85f0222cef523c9c5d27c "Torture
testing: 'libgomp.fortran/use_device_ptr-optional-2.f90'", see attached.


Grüße
 Thomas


-----------------
Mentor Graphics (Deutschland) GmbH, Arnulfstraße 201, 80634 München / Germany
Registergericht München HRB 106955, Geschäftsführer: Thomas Heurung, Alexander Walter
diff mbox series

Patch

2019-11-06  Tobias Burnus  <tobias@codesourcery.com>
	    Kwok Cheung Yeung  <kcy@codesourcery.com>

	gcc/
	* langhooks-def.h (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT):
	Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; update define.
	(LANG_HOOKS_DECLS): Rename also here.
	* langhooks.h (lang_hooks_for_decls): Rename
	omp_is_optional_argument to omp_check_optional_argument; take
	additional bool argument.
	* omp-general.h (omp_check_optional_argument): Likewise.
	* omp-general.h (omp_check_optional_argument): Likewise.
	* omp-low.c (lower_omp_target): Update calls; handle absent
	Fortran optional arguments with USE_DEVICE_ADDR/USE_DEVICE_PTR.

	gcc/fortran/
	* trans-decl.c (create_function_arglist): Also set
	GFC_DECL_OPTIONAL_ARGUMENT for per-value arguments.
	* f95-lang.c (LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT):
	Renamed from LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT; point
	to gfc_omp_check_optional_argument.
	* trans.h (gfc_omp_check_optional_argument): Subsitutes
	gfc_omp_is_optional_argument declaration.
	* trans-openmp.c (gfc_omp_is_optional_argument): Make static.
	(gfc_omp_check_optional_argument): New function.

	libgomp/
	* testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: New.

 gcc/fortran/f95-lang.c                                          |  4 ++--
 gcc/fortran/trans-decl.c                                        |  3 +--
 gcc/fortran/trans-openmp.c                                      | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-----
 gcc/fortran/trans.h                                             |  2 +-
 gcc/langhooks-def.h                                             |  4 ++--
 gcc/langhooks.h                                                 | 13 ++++++++-----
 gcc/omp-general.c                                               | 14 ++++++++++----
 gcc/omp-general.h                                               |  2 +-
 gcc/omp-low.c                                                   | 98 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------
 libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 | 33 +++++++++++++++++++++++++++++++++
 10 files changed, 191 insertions(+), 44 deletions(-)

diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 0684c3b99cf..c7b592dbfe2 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -115,7 +115,7 @@  static const struct attribute_spec gfc_attribute_table[] =
 #undef LANG_HOOKS_INIT_TS
 #undef LANG_HOOKS_OMP_ARRAY_DATA
 #undef LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR
-#undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT
+#undef LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT
 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
 #undef LANG_HOOKS_OMP_REPORT_DECL
@@ -150,7 +150,7 @@  static const struct attribute_spec gfc_attribute_table[] =
 #define LANG_HOOKS_INIT_TS		gfc_init_ts
 #define LANG_HOOKS_OMP_ARRAY_DATA		gfc_omp_array_data
 #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR	gfc_omp_is_allocatable_or_ptr
-#define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT	gfc_omp_is_optional_argument
+#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT	gfc_omp_check_optional_argument
 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE	gfc_omp_privatize_by_reference
 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING	gfc_omp_predetermined_sharing
 #define LANG_HOOKS_OMP_REPORT_DECL		gfc_omp_report_decl
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index ffa61111316..80ef45d892e 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2691,9 +2691,8 @@  create_function_arglist (gfc_symbol * sym)
 	  && (!f->sym->attr.proc_pointer
 	      && f->sym->attr.flavor != FL_PROCEDURE))
 	DECL_BY_REFERENCE (parm) = 1;
-      if (f->sym->attr.optional && !f->sym->attr.value)
+      if (f->sym->attr.optional)
 	{
-	  /* With value, the argument is passed as is.  */
 	  gfc_allocate_lang_decl (parm);
 	  GFC_DECL_OPTIONAL_ARGUMENT (parm) = 1;
 	}
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 14a3c3e4284..3b82eaf8051 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -58,19 +58,71 @@  gfc_omp_is_allocatable_or_ptr (const_tree decl)
 	      || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)));
 }
 
-/* True if OpenMP should treat this DECL as an optional argument;  note: for
-   arguments with VALUE attribute, the DECL is identical to nonoptional
-   arguments; hence, we return false here.  To check whether the variable is
-   present, use the DECL which is passed as hidden argument.  */
+/* True if the argument is an optional argument; except that false is also
+   returned for arguments with the value attribute (nonpointers) and for
+   assumed-shape variables (decl is a local variable containing arg->data).  */
 
-bool
+static bool
 gfc_omp_is_optional_argument (const_tree decl)
 {
   return (TREE_CODE (decl) == PARM_DECL
 	  && DECL_LANG_SPECIFIC (decl)
+	  && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE
 	  && GFC_DECL_OPTIONAL_ARGUMENT (decl));
 }
 
+/* Check whether this DECL belongs to a Fortran optional argument.
+   With 'for_present_check' set to false, decls which are optional parameters
+   themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
+   always pointers.  With 'for_present_check' set to true, the decl for checking
+   whether an argument is present is returned; for arguments with value
+   attribute this is the hidden argument and of BOOLEAN_TYPE.  If the decl is
+   unrelated to optional arguments, NULL_TREE is returned.  */
+
+tree
+gfc_omp_check_optional_argument (tree decl, bool for_present_check)
+{
+  if (!for_present_check)
+    return gfc_omp_is_optional_argument (decl) ? decl : NULL_TREE;
+
+  if (!DECL_LANG_SPECIFIC (decl))
+    return NULL_TREE;
+
+  /* For assumed-shape arrays, a local decl with arg->data is used.  */
+  if (TREE_CODE (decl) != PARM_DECL
+      && (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
+	  || GFC_ARRAY_TYPE_P (TREE_TYPE (decl))))
+    decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
+
+  if (TREE_CODE (decl) != PARM_DECL
+      || !DECL_LANG_SPECIFIC (decl)
+      || !GFC_DECL_OPTIONAL_ARGUMENT (decl))
+    return NULL_TREE;
+
+  /* For VALUE, the scalar variable is passed as is but a hidden argument
+     denotes the value.  Cf. trans-expr.c.  */
+  if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE)
+    {
+      char name[GFC_MAX_SYMBOL_LEN + 2];
+      tree tree_name;
+
+      name[0] = '_';
+      strcpy (&name[1], IDENTIFIER_POINTER (DECL_NAME (decl)));
+      tree_name = get_identifier (name);
+
+      /* Walk function argument list to find the hidden arg.  */
+      decl = DECL_ARGUMENTS (DECL_CONTEXT (decl));
+      for ( ; decl != NULL_TREE; decl = TREE_CHAIN (decl))
+	if (DECL_NAME (decl) == tree_name)
+	  break;
+
+      gcc_assert (decl);
+      return decl;
+    }
+
+  return decl;
+}
+
 
 /* Returns tree with NULL if it is not an array descriptor and with the tree to
    access the 'data' component otherwise.  With type_only = true, it returns the
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 364efe51d7c..359c7a2561a 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -787,7 +787,7 @@  bool gfc_get_array_descr_info (const_tree, struct array_descr_info *);
 
 /* In trans-openmp.c */
 bool gfc_omp_is_allocatable_or_ptr (const_tree);
-bool gfc_omp_is_optional_argument (const_tree);
+tree gfc_omp_check_optional_argument (tree, bool);
 tree gfc_omp_array_data (tree, bool);
 bool gfc_omp_privatize_by_reference (const_tree);
 enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index 2d3ad9a0a76..4002f281ddd 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -241,7 +241,7 @@  extern tree lhd_unit_size_without_reusable_padding (tree);
 #define LANG_HOOKS_DECL_OK_FOR_SIBCALL	lhd_decl_ok_for_sibcall
 #define LANG_HOOKS_OMP_ARRAY_DATA	hook_tree_tree_bool_null
 #define LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR hook_bool_const_tree_false
-#define LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT hook_bool_const_tree_false
+#define LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT hook_tree_tree_bool_null
 #define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false
 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING lhd_omp_predetermined_sharing
 #define LANG_HOOKS_OMP_REPORT_DECL lhd_pass_through_t
@@ -269,7 +269,7 @@  extern tree lhd_unit_size_without_reusable_padding (tree);
   LANG_HOOKS_DECL_OK_FOR_SIBCALL, \
   LANG_HOOKS_OMP_ARRAY_DATA, \
   LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR, \
-  LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT, \
+  LANG_HOOKS_OMP_CHECK_OPTIONAL_ARGUMENT, \
   LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \
   LANG_HOOKS_OMP_PREDETERMINED_SHARING, \
   LANG_HOOKS_OMP_REPORT_DECL, \
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index 39d3608b5f8..0e451c15ffc 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -235,11 +235,14 @@  struct lang_hooks_for_decls
      allocatable or pointer attribute.  */
   bool (*omp_is_allocatable_or_ptr) (const_tree);
 
-  /* True if OpenMP should treat DECL as a Fortran optional argument;  note: for
-     arguments with VALUE attribute, the DECL is identical to nonoptional
-     arguments; hence, we return false here.  To check whether the variable is
-     present, use the DECL which is passed as hidden argument.  */
-  bool (*omp_is_optional_argument) (const_tree);
+  /* Check whether this DECL belongs to a Fortran optional argument.
+     With 'for_present_check' set to false, decls which are optional parameters
+     themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
+     always pointers.  With 'for_present_check' set to true, the decl for
+     checking whether an argument is present is returned; for arguments with
+     value attribute this is the hidden argument and of BOOLEAN_TYPE.  If the
+     decl is unrelated to optional arguments, NULL_TREE is returned.  */
+  tree (*omp_check_optional_argument) (tree, bool);
 
   /* True if OpenMP should privatize what this DECL points to rather
      than the DECL itself.  */
diff --git a/gcc/omp-general.c b/gcc/omp-general.c
index 72a0f20feee..deb4e7996e8 100644
--- a/gcc/omp-general.c
+++ b/gcc/omp-general.c
@@ -63,12 +63,18 @@  omp_is_allocatable_or_ptr (tree decl)
   return lang_hooks.decls.omp_is_allocatable_or_ptr (decl);
 }
 
-/* Return true if DECL is a Fortran optional argument.  */
+/* Check whether this DECL belongs to a Fortran optional argument.
+   With 'for_present_check' set to false, decls which are optional parameters
+   themselve are returned as tree - or a NULL_TREE otherwise. Those decls are
+   always pointers.  With 'for_present_check' set to true, the decl for checking
+   whether an argument is present is returned; for arguments with value
+   attribute this is the hidden argument and of BOOLEAN_TYPE.  If the decl is
+   unrelated to optional arguments, NULL_TREE is returned.  */
 
-bool
-omp_is_optional_argument (tree decl)
+tree
+omp_check_optional_argument (tree decl, bool also_value)
 {
-  return lang_hooks.decls.omp_is_optional_argument (decl);
+  return lang_hooks.decls.omp_check_optional_argument (decl, also_value);
 }
 
 /* Return true if DECL is a reference type.  */
diff --git a/gcc/omp-general.h b/gcc/omp-general.h
index fe5c25b08ab..1cf007e3371 100644
--- a/gcc/omp-general.h
+++ b/gcc/omp-general.h
@@ -74,7 +74,7 @@  struct omp_for_data
 
 extern tree omp_find_clause (tree clauses, enum omp_clause_code kind);
 extern bool omp_is_allocatable_or_ptr (tree decl);
-extern bool omp_is_optional_argument (tree decl);
+extern tree omp_check_optional_argument (tree decl, bool also_value);
 extern bool omp_is_reference (tree decl);
 extern void omp_adjust_for_condition (location_t loc, enum tree_code *cond_code,
 				      tree *n2, tree v, tree step);
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index fa76ceba33c..ba39ccc390c 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -11796,12 +11796,12 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 		    if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM
 			 || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO)
 			&& (omp_is_allocatable_or_ptr (var)
-			    && omp_is_optional_argument (var)))
+			    && omp_check_optional_argument (var, false)))
 		      var = build_fold_indirect_ref (var);
 		    else if ((OMP_CLAUSE_CODE (c) != OMP_CLAUSE_FROM
 			      && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TO)
 			     || (!omp_is_allocatable_or_ptr (var)
-				 && !omp_is_optional_argument (var)))
+				 && !omp_check_optional_argument (var, false)))
 		      var = build_fold_addr_expr (var);
 		    gimplify_assign (x, var, &ilist);
 		  }
@@ -12005,7 +12005,7 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	    else
 	      {
 		if (omp_is_reference (ovar)
-		    || omp_is_optional_argument (ovar)
+		    || omp_check_optional_argument (ovar, false)
 		    || omp_is_allocatable_or_ptr (ovar))
 		  {
 		    type = TREE_TYPE (type);
@@ -12018,7 +12018,30 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 		    var = fold_convert (TREE_TYPE (x), var);
 		  }
 	      }
-	    gimplify_assign (x, var, &ilist);
+	    if (omp_check_optional_argument (ovar, true))
+	      {
+		tree null_label = create_artificial_label (UNKNOWN_LOCATION);
+		tree notnull_label = create_artificial_label (UNKNOWN_LOCATION);
+		tree opt_arg_label = create_artificial_label (UNKNOWN_LOCATION);
+		tree new_x = unshare_expr (x);
+		tree present = omp_check_optional_argument (ovar, true);
+		gimplify_expr (&present, &ilist, NULL, is_gimple_val,
+			       fb_rvalue);
+		gcond *cond = gimple_build_cond_from_tree (present,
+							   notnull_label,
+							   null_label);
+		gimple_seq_add_stmt (&ilist, cond);
+		gimple_seq_add_stmt (&ilist, gimple_build_label (null_label));
+		gimplify_assign (new_x, null_pointer_node, &ilist);
+		gimple_seq_add_stmt (&ilist, gimple_build_goto (opt_arg_label));
+		gimple_seq_add_stmt (&ilist,
+				     gimple_build_label (notnull_label));
+		gimplify_assign (x, var, &ilist);
+		gimple_seq_add_stmt (&ilist,
+				     gimple_build_label (opt_arg_label));
+	      }
+	    else
+	      gimplify_assign (x, var, &ilist);
 	    s = size_int (0);
 	    purpose = size_int (map_idx++);
 	    CONSTRUCTOR_APPEND_ELT (vsize, purpose, s);
@@ -12168,6 +12191,9 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	  case OMP_CLAUSE_USE_DEVICE_ADDR:
 	  case OMP_CLAUSE_IS_DEVICE_PTR:
 	    var = OMP_CLAUSE_DECL (c);
+	    tree new_var;
+	    gimple_seq assign_body;
+	    assign_body = NULL;
 	    bool is_array_data;
 	    is_array_data = lang_hooks.decls.omp_array_data (var, true) != NULL;
 
@@ -12183,32 +12209,32 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 		bool is_ref = omp_is_reference (var);
 		/* First, we copy the descriptor data from the host; then
 		   we update its data to point to the target address.  */
-		tree new_var = lookup_decl (var, ctx);
+		new_var = lookup_decl (var, ctx);
 		new_var = DECL_VALUE_EXPR (new_var);
 		tree v = new_var;
 
 		if (is_ref)
 		  {
 		    var = build_fold_indirect_ref (var);
-		    gimplify_expr (&var, &new_body, NULL, is_gimple_val,
+		    gimplify_expr (&var, &assign_body, NULL, is_gimple_val,
 				   fb_rvalue);
 		    v = create_tmp_var_raw (TREE_TYPE (var), get_name (var));
 		    gimple_add_tmp_var (v);
 		    TREE_ADDRESSABLE (v) = 1;
-		    gimple_seq_add_stmt (&new_body,
+		    gimple_seq_add_stmt (&assign_body,
 					 gimple_build_assign (v, var));
 		    tree rhs = build_fold_addr_expr (v);
-		    gimple_seq_add_stmt (&new_body,
+		    gimple_seq_add_stmt (&assign_body,
 					 gimple_build_assign (new_var, rhs));
 		  }
 		else
-		  gimple_seq_add_stmt (&new_body,
+		  gimple_seq_add_stmt (&assign_body,
 				       gimple_build_assign (new_var, var));
 
 		tree v2 = lang_hooks.decls.omp_array_data (unshare_expr (v), false);
 		gcc_assert (v2);
-		gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
-		gimple_seq_add_stmt (&new_body,
+		gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
+		gimple_seq_add_stmt (&assign_body,
 				     gimple_build_assign (v2, x));
 	      }
 	    else if (is_variable_sized (var))
@@ -12217,9 +12243,9 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 		gcc_assert (TREE_CODE (pvar) == INDIRECT_REF);
 		pvar = TREE_OPERAND (pvar, 0);
 		gcc_assert (DECL_P (pvar));
-		tree new_var = lookup_decl (pvar, ctx);
-		gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
-		gimple_seq_add_stmt (&new_body,
+		new_var = lookup_decl (pvar, ctx);
+		gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
+		gimple_seq_add_stmt (&assign_body,
 				     gimple_build_assign (new_var, x));
 	      }
 	    else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
@@ -12227,19 +12253,19 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 		      && !omp_is_allocatable_or_ptr (var))
 		     || TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
 	      {
-		tree new_var = lookup_decl (var, ctx);
+		new_var = lookup_decl (var, ctx);
 		new_var = DECL_VALUE_EXPR (new_var);
 		gcc_assert (TREE_CODE (new_var) == MEM_REF);
 		new_var = TREE_OPERAND (new_var, 0);
 		gcc_assert (DECL_P (new_var));
-		gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
-		gimple_seq_add_stmt (&new_body,
+		gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
+		gimple_seq_add_stmt (&assign_body,
 				     gimple_build_assign (new_var, x));
 	      }
 	    else
 	      {
 		tree type = TREE_TYPE (var);
-		tree new_var = lookup_decl (var, ctx);
+		new_var = lookup_decl (var, ctx);
 		if (omp_is_reference (var))
 		  {
 		    type = TREE_TYPE (type);
@@ -12252,19 +12278,47 @@  lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 			gimple_add_tmp_var (v);
 			TREE_ADDRESSABLE (v) = 1;
 			x = fold_convert (type, x);
-			gimplify_expr (&x, &new_body, NULL, is_gimple_val,
+			gimplify_expr (&x, &assign_body, NULL, is_gimple_val,
 				       fb_rvalue);
-			gimple_seq_add_stmt (&new_body,
+			gimple_seq_add_stmt (&assign_body,
 					     gimple_build_assign (v, x));
 			x = build_fold_addr_expr (v);
 		      }
 		  }
 		new_var = DECL_VALUE_EXPR (new_var);
 		x = fold_convert (TREE_TYPE (new_var), x);
-		gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
-		gimple_seq_add_stmt (&new_body,
+		gimplify_expr (&x, &assign_body, NULL, is_gimple_val, fb_rvalue);
+		gimple_seq_add_stmt (&assign_body,
 				     gimple_build_assign (new_var, x));
 	      }
+	    if (omp_check_optional_argument (OMP_CLAUSE_DECL (c), true))
+	      {
+		tree null_label = create_artificial_label (UNKNOWN_LOCATION);
+		tree notnull_label = create_artificial_label (UNKNOWN_LOCATION);
+		tree opt_arg_label = create_artificial_label (UNKNOWN_LOCATION);
+		glabel *null_glabel = gimple_build_label (null_label);
+		glabel *notnull_glabel = gimple_build_label (notnull_label);
+		ggoto *opt_arg_ggoto = gimple_build_goto (opt_arg_label);
+		gimplify_expr (&x, &new_body, NULL, is_gimple_val,
+					   fb_rvalue);
+		tree present = omp_check_optional_argument (OMP_CLAUSE_DECL (c),
+							    true);
+		gimplify_expr (&present, &new_body, NULL, is_gimple_val,
+			       fb_rvalue);
+		gcond *cond = gimple_build_cond_from_tree (present,
+							   notnull_label,
+							   null_label);
+		gimple_seq_add_stmt (&new_body, cond);
+		gimple_seq_add_stmt (&new_body, null_glabel);
+		gimplify_assign (new_var, null_pointer_node, &new_body);
+		gimple_seq_add_stmt (&new_body, opt_arg_ggoto);
+		gimple_seq_add_stmt (&new_body, notnull_glabel);
+		gimple_seq_add_seq (&new_body, assign_body);
+		gimple_seq_add_stmt (&new_body,
+				     gimple_build_label (opt_arg_label));
+	      }
+	    else
+	      gimple_seq_add_seq (&new_body, assign_body);
 	    break;
 	  }
       /* Handle GOMP_MAP_FIRSTPRIVATE_{POINTER,REFERENCE} in second pass,
diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
new file mode 100644
index 00000000000..41abf17eede
--- /dev/null
+++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
@@ -0,0 +1,33 @@ 
+! Check whether absent optional arguments are properly
+! handled with use_device_{addr,ptr}.
+program main
+ implicit none (type, external)
+ call foo()
+contains
+  subroutine foo(v, w, x, y, z)
+    integer, target, optional, value :: v
+    integer, target, optional :: w
+    integer, target, optional :: x(:)
+    integer, target, optional, allocatable :: y
+    integer, target, optional, allocatable :: z(:)
+    integer :: d
+
+    !$omp target data map(d) use_device_addr(v, w, x, y, z)
+      if(present(v)) stop 1
+      if(present(w)) stop 2
+      if(present(x)) stop 3
+      if(present(y)) stop 4
+      if(present(z)) stop 5
+    !$omp end target data
+
+! Using 'v' in use_device_ptr gives an ICE
+! TODO: Find out what the OpenMP spec permits for use_device_ptr
+
+    !$omp target data map(d) use_device_ptr(w, x, y, z)
+      if(present(w)) stop 6
+      if(present(x)) stop 7
+      if(present(y)) stop 8
+      if(present(z)) stop 9
+    !$omp end target data
+  end subroutine foo
+end program main