[OpenMP] Fix use_device_… with absent optional arg

diff mbox series

This fixes two issues with the recently added absent-optional patch for 
use_device_…

(a) For nonallocatable, nonpointer arrays the data component of the 
array descriptor is replaced by a local variable – if the argument is 
absent, this variable is not initialized and, unless it is NULL, a 
pointer to undefined memory attempted to be mapped.

(b) For per-value arguments, the dummy argument itself always exists and 
as it is not a pointer, there is nothing to dereference. Hence, 
'use_device_addr(val_arg)' can be run unconditionally. However, doing so 
will fail if 'val_arg' has never been mapped to the device. – I think 
the most sensible is to update the test case. (One could add a 
condition, to use a NULL pointer if absent, but as I cannot come up with 
a valid program, leaving the condition out in the generated code makes 
more sense.)

OK?

Tobias

PS: I wonder why I didn't see it when initially submitting the patch. I 
think it must be after I did a small change and did a quick regtesting. 
I assume for some reasons the device became unavailable – turning all 
checks into unsupported and I only looked for FAIL and didn't check 
whether some new unsupported popped up. – Namely, 
use_device_addr-{3,4}.f90 failed without (a) – but only with -O1 (and 
with 1 of 11 (hardware, cuda version) combos with -Os). 
use_device_ptr-optional-2.f90 failed with '-O' (which is the only option 
which was actually run) due to (a) and (b).

Revised patch after some re-considerations (and finding tons of issues 
with VALUE + OPTIONAL in gfortran itself). – What the patch does [all 
related to use_device_{addr,ptr} and 'optional' arguments]:

For assumed-shape arrays, the compiler generates code like "if (arg) 
arg.0 = arg->data;". Hence, arg.0 was always available – but possibly 
pointing to uninitialized memory. – Likewise, per-value-passed 
arguments, 'arg' (i.e. &arg) is always available. — But, in the absent 
case, if 'arg->data is not NULL or the per-value decl is not mapped (cf. 
test case), that's not the best idea.

I thought that I don't need a condition in thoses case – but it turns 
out that the offloading plugin might (rightly!) complain that the 
address is not mapped. – Hence, I add the is-present condition now also 
in for those case; as none remain, the do_optional_check is now gone.

However, after the library call, amp_arr.arg is known to be initialized. 
In this case, I keep the do_optional_check check. – This avoids code 
which boils down to  "x0 = arg ? omp_arr.arg : NULL". – and keeps 
generating condtions only for complex code such as:  if (present) { 
tmp.data = omp_arr.arg; arg = &tmp; } else {arg = NULL;}.

Finally, while testing/exploring value+optional bugs, I stumbled over 
'type(c_ptr),value' which is 'void *'. In particular, it is pointer but 
still the is-present status is passed as hidden argument. This patch 
fixes both mapping and the is-present check.

Build on x86-64-gnu-linux + tested once on a system without offloading 
support and with nvptx offloading.
OK?

Tobias

PS: Regarding the issues with OPTIONAL and VALUE, see PR fortran/92703 
and PR fortran/92702. Found issues: const-len character strings are 
passed as value w/o hidden is-present arg but func call passes them; 
those and derived types/the outer class container are passed by value - 
but the 'present()' check assumes pointers (hence: ICE); if basent 
null_ptr_node is passed, I fear that this will give stack issues, at 
least on some platforms. — Additionally, deferred-length character 
strings and arrays are permitted since F2008 but not yet supported.
gcc/fortran/
	* trans-openmp.c (gfc_omp_is_optional_argument,
	gfc_omp_check_optional_argument): Handle type(c_ptr),value which uses a
	hidden argument for the is-present check.

	gcc/
	* omp-low.c (lower_omp_target): For use_device_ptr/use_derice_addr
	and Fortran's optional arguments, unconditionally add the is-present
	condition before the libgomp call.

	libgomp/
	* testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Add
	'type(c_ptr), value' test case. Conditionally map the per-value
	passed arguments.

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index d9dfcabc65e..f21785fa8c3 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -60,7 +60,8 @@ gfc_omp_is_allocatable_or_ptr (const_tree decl)
 
 /* 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).  */
+   assumed-shape variables (decl is a local variable containing arg->data).
+   Note that pvoid_type_node is for 'type(c_ptr), value.  */
 
 static bool
 gfc_omp_is_optional_argument (const_tree decl)
@@ -68,6 +69,7 @@ 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
+	  && TREE_TYPE (decl) != pvoid_type_node
 	  && GFC_DECL_OPTIONAL_ARGUMENT (decl));
 }
 
@@ -99,9 +101,12 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check)
       || !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)
+   /* Scalars with VALUE attribute which are passed by value use a hidden
+      argument to denote the present status.  They are passed as nonpointer type
+      with one exception: 'type(c_ptr), value' as '*void'.  */
+   /* Cf. trans-expr.c's gfc_conv_expr_present.  */
+   if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE
+       || TREE_TYPE (decl) == pvoid_type_node)
     {
       char name[GFC_MAX_SYMBOL_LEN + 2];
       tree tree_name;
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 19132f76da2..0e66a68ff36 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -11981,8 +11981,6 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	  case OMP_CLAUSE_USE_DEVICE_PTR:
 	  case OMP_CLAUSE_USE_DEVICE_ADDR:
 	  case OMP_CLAUSE_IS_DEVICE_PTR:
-	    bool do_optional_check;
-	    do_optional_check = false;
 	    ovar = OMP_CLAUSE_DECL (c);
 	    var = lookup_decl_in_outer_ctx (ovar, ctx);
 
@@ -12004,10 +12002,7 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	      }
 	    type = TREE_TYPE (ovar);
 	    if (lang_hooks.decls.omp_array_data (ovar, true))
-	      {
-		var = lang_hooks.decls.omp_array_data (ovar, false);
-		do_optional_check = true;
-	      }
+	      var = lang_hooks.decls.omp_array_data (ovar, false);
 	    else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
 		      && !omp_is_reference (ovar)
 		      && !omp_is_allocatable_or_ptr (ovar))
@@ -12027,14 +12022,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 			       && omp_is_allocatable_or_ptr (ovar))))
 		      {
 			var = build_simple_mem_ref (var);
-			do_optional_check = true;
 		      }
 		    var = fold_convert (TREE_TYPE (x), var);
 		  }
 	      }
 	    tree present;
-	    present = (do_optional_check
-		       ? omp_check_optional_argument (ovar, true) : NULL_TREE);
+	    present = omp_check_optional_argument (ovar, true);
 	    if (present)
 	      {
 		tree null_label = create_artificial_label (UNKNOWN_LOCATION);
diff --git a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90 b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
index 41abf17eede..e57abfbed5c 100644
--- a/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
+++ b/libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90
@@ -1,33 +1,47 @@
 ! Check whether absent optional arguments are properly
 ! handled with use_device_{addr,ptr}.
 program main
+ use iso_c_binding, only: c_ptr, c_loc
  implicit none (type, external)
  call foo()
 contains
-  subroutine foo(v, w, x, y, z)
+  subroutine foo(v, w, x, y, z, cptr)
     integer, target, optional, value :: v
     integer, target, optional :: w
     integer, target, optional :: x(:)
     integer, target, optional, allocatable :: y
     integer, target, optional, allocatable :: z(:)
+    type(c_ptr), target, optional, value :: cptr
     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
+    ! Need to map per-VALUE arguments, if present
+    if (present(v)) then
+      !$omp target enter data map(to:v)
+      stop 1  ! – but it shall not be present in this test case.
+    end if
+    if (present(cptr)) then
+      !$omp target enter data map(to:cptr)
+      stop 2  ! – but it shall not be present in this test case.
+    end if
+
+    !$omp target data map(d) use_device_addr(v, w, x, y, z, cptr)
+      if (present(v)) then; v    = 5; stop 1; endif
+      if (present(w)) then; w    = 5; stop 2; endif
+      if (present(x)) then; x(1) = 5; stop 3; endif
+      if (present(y)) then; y    = 5; stop 4; endif
+      if (present(z)) then; z(1) = 5; stop 5; endif
+      if (present(cptr)) then; cptr = c_loc(v); stop 6; endif
     !$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 target data map(d) use_device_ptr(w, x, y, z, cptr)
+      if(present(w)) then; w    = 5; stop 11; endif
+      if(present(x)) then; x(1) = 5; stop 12; endif
+      if(present(y)) then; y    = 5; stop 13; endif
+      if(present(z)) then; z(1) = 5; stop 14; endif
+      if(present(cptr)) then; cptr = c_loc(x); stop 15; endif
     !$omp end target data
   end subroutine foo
 end program main

On Fri, Nov 29, 2019 at 01:03:13PM +0100, Tobias Burnus wrote:
> --- a/gcc/fortran/trans-openmp.c

> +++ b/gcc/fortran/trans-openmp.c

> @@ -60,7 +60,8 @@ gfc_omp_is_allocatable_or_ptr (const_tree decl)

>  

>  /* 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).  */

> +   assumed-shape variables (decl is a local variable containing arg->data).

> +   Note that pvoid_type_node is for 'type(c_ptr), value.  */

>  

>  static bool

>  gfc_omp_is_optional_argument (const_tree decl)

> @@ -68,6 +69,7 @@ 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

> +	  && TREE_TYPE (decl) != pvoid_type_node


Is it always pvoid_type_node, or could it be say const qualified version
thereof etc. (C void const *) etc.?  If the latter, then
	  && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
might be better check.  If it is always just pvoid_type_node, the above is
fine sure.

>  	  && GFC_DECL_OPTIONAL_ARGUMENT (decl));

>  }

>  

> @@ -99,9 +101,12 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check)

>        || !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)

> +   /* Scalars with VALUE attribute which are passed by value use a hidden

> +      argument to denote the present status.  They are passed as nonpointer type

> +      with one exception: 'type(c_ptr), value' as '*void'.  */


void* or void * instead of *void?

> +   /* Cf. trans-expr.c's gfc_conv_expr_present.  */

> +   if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE

> +       || TREE_TYPE (decl) == pvoid_type_node)


And similar question to the above one.

> @@ -12027,14 +12022,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)

>  			       && omp_is_allocatable_or_ptr (ovar))))

>  		      {

>  			var = build_simple_mem_ref (var);

> -			do_optional_check = true;

>  		      }


The above then becomes { single_stmt } and so should be changed to
single_stmt without {}s around it.

> @@ -1,33 +1,47 @@

>  ! Check whether absent optional arguments are properly

>  ! handled with use_device_{addr,ptr}.

>  program main

> + use iso_c_binding, only: c_ptr, c_loc

>   implicit none (type, external)

>   call foo()

>  contains

> -  subroutine foo(v, w, x, y, z)

> +  subroutine foo(v, w, x, y, z, cptr)

>      integer, target, optional, value :: v

>      integer, target, optional :: w

>      integer, target, optional :: x(:)

>      integer, target, optional, allocatable :: y

>      integer, target, optional, allocatable :: z(:)

> +    type(c_ptr), target, optional, value :: cptr

>      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

> +    ! Need to map per-VALUE arguments, if present

> +    if (present(v)) then

> +      !$omp target enter data map(to:v)

> +      stop 1  ! – but it shall not be present in this test case.

> +    end if

> +    if (present(cptr)) then

> +      !$omp target enter data map(to:cptr)

> +      stop 2  ! – but it shall not be present in this test case.

> +    end if


Shouln't the stop arguments differ from anything else already in the
testcase?

> +

> +    !$omp target data map(d) use_device_addr(v, w, x, y, z, cptr)

> +      if (present(v)) then; v    = 5; stop 1; endif

> +      if (present(w)) then; w    = 5; stop 2; endif

> +      if (present(x)) then; x(1) = 5; stop 3; endif

> +      if (present(y)) then; y    = 5; stop 4; endif

> +      if (present(z)) then; z(1) = 5; stop 5; endif

> +      if (present(cptr)) then; cptr = c_loc(v); stop 6; endif

>      !$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 target data map(d) use_device_ptr(w, x, y, z, cptr)

> +      if(present(w)) then; w    = 5; stop 11; endif

> +      if(present(x)) then; x(1) = 5; stop 12; endif

> +      if(present(y)) then; y    = 5; stop 13; endif

> +      if(present(z)) then; z(1) = 5; stop 14; endif

> +      if(present(cptr)) then; cptr = c_loc(x); stop 15; endif

>      !$omp end target data

>    end subroutine foo

>  end program main


Otherwise LGTM.

	Jakub

Hi Jakub,

thanks for the review – committed as Rev. 279004.

On 12/5/19 12:46 PM, Jakub Jelinek wrote:
> On Fri, Nov 29, 2019 at 01:03:13PM +0100, Tobias Burnus wrote:

>> --- a/gcc/fortran/trans-openmp.c

>> +	  && TREE_TYPE (decl) != pvoid_type_node

> Is it always pvoid_type_node, or could it be say const qualified version

> thereof etc. (C void const *) etc.? If the latter, then

> 	  && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))

> might be better check.  If it is always just pvoid_type_node, the above is

> fine sure.


I will use your version (twice) just to be sure. — Currently, I think it 
will always be pvoid_type_node but I don't want to rule out some const 
qualifier might be possible. (volatile is not permitted with value, 
restricted and atomic qualifiers are unlikely.)

[…]

> Shouln't the stop arguments differ from anything else already in the 

> testcase? 

Yes – it makes failure debugging easier. I thought, I had re-enumerated, 
but I missed the two.

Tobias