OpenMP] Fix use_device_… with absent optional arg
authorTobias Burnus <tobias@codesourcery.com>
Thu, 5 Dec 2019 15:18:39 +0000 (15:18 +0000)
committerTobias Burnus <burnus@gcc.gnu.org>
Thu, 5 Dec 2019 15:18:39 +0000 (16:18 +0100)
        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.

From-SVN: r279004

gcc/ChangeLog
gcc/fortran/ChangeLog
gcc/fortran/trans-openmp.c
gcc/omp-low.c
gcc/testsuite/ChangeLog
libgomp/testsuite/libgomp.fortran/use_device_ptr-optional-2.f90

index 83d66f1..87dc67e 100644 (file)
@@ -1,3 +1,9 @@
+2019-12-05  Tobias Burnus  <tobias@codesourcery.com>
+
+       * 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.
+
 2019-12-05  Richard Sandiford  <richard.sandiford@arm.com>
 
        PR middle-end/92768
index 2cdee32..04861c7 100644 (file)
@@ -1,3 +1,8 @@
+2019-12-05  Tobias Burnus  <tobias@codesourcery.com>
+
+       * trans-openmp.c (gfc_omp_is_optional_argument,
+       gfc_omp_check_optional_argument): Handle type(c_ptr),value which uses a
+
 2019-12-05  Jakub Jelinek  <jakub@redhat.com>
 
        PR fortran/92781
index 3a4f962..2f9456d 100644 (file)
@@ -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
+         && !VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))
          && 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
+       || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
     {
       char name[GFC_MAX_SYMBOL_LEN + 2];
       tree tree_name;
index 19132f7..b0168d7 100644 (file)
@@ -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))
@@ -12025,16 +12020,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
                            && !omp_is_allocatable_or_ptr (ovar))
                           || (omp_is_reference (ovar)
                               && omp_is_allocatable_or_ptr (ovar))))
-                     {
-                       var = build_simple_mem_ref (var);
-                       do_optional_check = true;
-                     }
+                     var = build_simple_mem_ref (var);
                    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);
index b2c6d10..34e5783 100644 (file)
@@ -1,3 +1,9 @@
+2019-12-05  Tobias Burnus  <tobias@codesourcery.com>
+
+       * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: Add
+       'type(c_ptr), value' test case. Conditionally map the per-value
+       passed arguments.
+
 2019-12-05  Richard Sandiford  <richard.sandiford@arm.com>
 
        PR middle-end/92768
index 41abf17..6eefbe1 100644 (file)
@@ -1,33 +1,60 @@
 ! Check whether absent optional arguments are properly
 ! handled with use_device_{addr,ptr}.
 program main
+ use iso_c_binding, only: c_ptr, c_loc, c_associated
  implicit none (type, external)
  call foo()
 contains
-  subroutine foo(v, w, x, y, z)
+  subroutine foo(v, w, x, y, z, cptr, cptr_in)
     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
+    type(c_ptr), target, optional, value, intent(in) :: cptr_in
     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
+    if (present(cptr_in)) then
+      !$omp target enter data map(to:cptr_in)
+      stop 3  ! – 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, cptr_in)
+      if (present(v)) then; v    = 5; stop 11; endif
+      if (present(w)) then; w    = 5; stop 12; endif
+      if (present(x)) then; x(1) = 5; stop 13; endif
+      if (present(y)) then; y    = 5; stop 14; endif
+      if (present(z)) then; z(1) = 5; stop 15; endif
+      if (present(cptr)) then; cptr = c_loc(v); stop 16; endif
+      if (present(cptr_in)) then
+        if (c_associated(cptr_in, c_loc(x))) stop 26
+        stop 27
+      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, cptr_in)
+      if (present(w)) then; w    = 5; stop 21; endif
+      if (present(x)) then; x(1) = 5; stop 22; endif
+      if (present(y)) then; y    = 5; stop 23; endif
+      if (present(z)) then; z(1) = 5; stop 24; endif
+      if (present(cptr)) then; cptr = c_loc(x); stop 25; endif
+      if (present(cptr_in)) then
+        if (c_associated(cptr_in, c_loc(x))) stop 26
+        stop 27
+      endif
     !$omp end target data
   end subroutine foo
 end program main