[PATCH 0/5, OpenACC] Add support for Fortran optional arguments in OpenACC

[Kwok Cheung Yeung]

This patchset allows the use of Fortran optional arguments in OpenACC
programs in accordance with section 2.17 of the OpenACC 2.6 specification.

These patches were originally posted at
https://gcc.gnu.org/ml/gcc-patches/2019-01/msg01750.html for the OG8
branch. This version is targeted at trunk.

Tested on x86_64 with offloading to a Nvidia Tesla K20c card.

Okay to apply to trunk?

Thanks

Kwok

[Kwok Cheung Yeung]

Fortran pass-by-reference optional arguments behave much like normal
Fortran arguments when lowered to GENERIC/GIMPLE, except they can be
null (representing a non-present argument).

Some parts of libgomp (those dealing with updating mappings) currently
do not expect to take a null address and fail. These need to be changed
to deal with the null appropriately, by turning the operation into a
no-op (as you never need to update a non-present argument).

        libgomp/
        * oacc-mem.c (update_dev_host): Return early if the host address
        is NULL.
        (gomp_acc_insert_pointer): Likewise.
        * testsuite/libgomp.oacc-c-c++-common/lib-43.c: Remove.
        * testsuite/libgomp.oacc-c-c++-common/lib-47.c: Likewise.
---
  libgomp/oacc-mem.c                                 |  9 ++++
  .../testsuite/libgomp.oacc-c-c++-common/lib-43.c   | 51
----------------------
  .../testsuite/libgomp.oacc-c-c++-common/lib-47.c   | 49
---------------------
  3 files changed, 9 insertions(+), 100 deletions(-)
  delete mode 100644 libgomp/testsuite/libgomp.oacc-c-c++-common/lib-43.c
  delete mode 100644 libgomp/testsuite/libgomp.oacc-c-c++-common/lib-47.c

diff --git a/libgomp/oacc-mem.c b/libgomp/oacc-mem.c
index 2f27100..8cc5120 100644
--- a/libgomp/oacc-mem.c
+++ b/libgomp/oacc-mem.c
@@ -831,6 +831,12 @@ update_dev_host (int is_dev, void *h, size_t s, int
async)
    if (acc_dev->capabilities & GOMP_OFFLOAD_CAP_SHARED_MEM)
      return;

+  /* Fortran optional arguments that are non-present result in a
+     null host address here.  This can safely be ignored as it is
+     not possible to 'update' a non-present optional argument.  */
+  if (h == NULL)
+    return;
+
    acc_prof_info prof_info;
    acc_api_info api_info;
    bool profiling_p = GOACC_PROFILING_SETUP_P (thr, &prof_info, &api_info);
@@ -901,6 +907,9 @@ gomp_acc_insert_pointer (size_t mapnum, void
**hostaddrs, size_t *sizes,
    struct goacc_thread *thr = goacc_thread ();
    struct gomp_device_descr *acc_dev = thr->dev;

+  if (*hostaddrs == NULL)
+    return;
+
    if (acc_is_present (*hostaddrs, *sizes))
      {
        splay_tree_key n;
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-43.c
b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-43.c
deleted file mode 100644
index 5db2912..0000000
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-43.c
+++ /dev/null
@@ -1,51 +0,0 @@
-/* Exercise acc_update_device with a NULL data address on nvidia
targets.  */
-
-/* { dg-do run { target openacc_nvidia_accel_selected } } */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <openacc.h>
-
-int
-main (int argc, char **argv)
-{
-  const int N = 256;
-  int i;
-  unsigned char *h;
-  void *d;
-
-  h = (unsigned char *) malloc (N);
-
-  for (i = 0; i < N; i++)
-    {
-      h[i] = i;
-    }
-
-  d = acc_copyin (h, N);
-  if (!d)
-    abort ();
-
-  for (i = 0; i < N; i++)
-    {
-      h[i] = 0xab;
-    }
-
-  fprintf (stderr, "CheCKpOInT\n");
-  acc_update_device (0, N);
-
-  acc_copyout (h, N);
-
-  for (i = 0; i < N; i++)
-    {
-      if (h[i] != 0xab)
- abort ();
-    }
-
-  free (h);
-
-  return 0;
-}
-
-/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */
-/* { dg-output "\\\[\[^\n\r]*,256\\\] is not mapped" } */
-/* { dg-shouldfail "" } */
diff --git a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-47.c
b/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-47.c
deleted file mode 100644
index c214042..0000000
--- a/libgomp/testsuite/libgomp.oacc-c-c++-common/lib-47.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/* Exercise acc_update_self with a NULL data mapping on nvidia targets.  */
-
-/* { dg-do run { target openacc_nvidia_accel_selected } } */
-
-#include <stdio.h>
-#include <string.h>
-#include <stdlib.h>
-#include <openacc.h>
-
-int
-main (int argc, char **argv)
-{
-  const int N = 256;
-  int i;
-  unsigned char *h;
-  void *d;
-
-  h = (unsigned char *) malloc (N);
-
-  for (i = 0; i < N; i++)
-    {
-      h[i] = i;
-    }
-
-  d = acc_copyin (h, N);
-  if (!d)
-    abort ();
-
-  memset (&h[0], 0, N);
-
-  fprintf (stderr, "CheCKpOInT\n");
-  acc_update_self (0, N);
-
-  for (i = 0; i < N; i++)
-    {
-      if (h[i] != i)
- abort ();
-    }
-
-  acc_delete (h, N);
-
-  free (h);
-
-  return 0;
-}
-
-/* { dg-output "CheCKpOInT(\n|\r\n|\r).*" } */
-/* { dg-output "\\\[\[^\n\r]*,256\\\] is not mapped" } */
-/* { dg-shouldfail "" } */
--
2.8.1

[Kwok Cheung Yeung]

This patch allows allocatable arrays passed as Fortran optional
arguments to be used in OpenACC. The GIMPLE code generated by the
current lowering unconditionally attempts to access fields within the
structure representing the array, resulting in a null dereference if the
array is non-present.

This patch generates extra code to test if the argument is null.
If so, it sets the size of the array contents to zero, and the
pointers to data to null. This avoids the null dereferences, prevents
libgomp from trying to copy non-existant data, and preserves the null
pointer used by PRESENT to detect non-present arguments.

        gcc/fortran/
        * trans-openmp.c (gfc_build_conditional_assign): New.
        (gfc_build_conditional_assign_expr): New.
        (gfc_omp_finish_clause): Add conditionals to set the clause
        declaration to null and size to zero if the declaration is a
        non-present optional argument.
        (gfc_trans_omp_clauses): Likewise.
---
  gcc/fortran/trans-openmp.c | 164
++++++++++++++++++++++++++++++++++++++-------
  1 file changed, 138 insertions(+), 26 deletions(-)

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 8eae7bc..8bfeeeb 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1067,6 +1067,62 @@ gfc_omp_clause_dtor (tree clause, tree decl)
    return tem;
  }

+/* Build a conditional expression in BLOCK.  If COND_VAL is not
+   null, then the block THEN_B is executed, otherwise ELSE_VAL
+   is assigned to VAL.  */
+
+static void
+gfc_build_conditional_assign (stmtblock_t *block,
+      tree val,
+      tree cond_val,
+      tree then_b,
+      tree else_val)
+{
+  stmtblock_t cond_block;
+  tree cond, else_b;
+  tree val_ty = TREE_TYPE (val);
+
+  gfc_init_block (&cond_block);
+  gfc_add_modify (&cond_block, val, fold_convert (val_ty, else_val));
+  else_b = gfc_finish_block (&cond_block);
+  cond = fold_convert (pvoid_type_node, cond_val);
+  cond = fold_build2_loc (input_location, NE_EXPR,
+  logical_type_node,
+  cond, null_pointer_node);
+  gfc_add_expr_to_block (block,
+ build3_loc (input_location,
+     COND_EXPR,
+     void_type_node,
+     cond, then_b,
+     else_b));
+}
+
+/* Build a conditional expression in BLOCK, returning a temporary
+   variable containing the result.  If COND_VAL is not null, then
+   THEN_VAL will be assigned to the variable, otherwise ELSE_VAL
+   is assigned.
+ */
+
+static tree
+gfc_build_conditional_assign_expr (stmtblock_t *block,
+   tree cond_val,
+   tree then_val,
+   tree else_val)
+{
+  tree val;
+  tree val_ty = TREE_TYPE (then_val);
+  stmtblock_t cond_block;
+
+  val = create_tmp_var (val_ty);
+
+  gfc_init_block (&cond_block);
+  gfc_add_modify (&cond_block, val, then_val);
+  tree then_b = gfc_finish_block (&cond_block);
+
+  gfc_build_conditional_assign (block, val, cond_val, then_b, else_val);
+
+  return val;
+}

  void
  gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
@@ -1124,17 +1180,46 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
        stmtblock_t block;
        gfc_start_block (&block);
        tree type = TREE_TYPE (decl);
-      tree ptr = gfc_conv_descriptor_data_get (decl);
+      bool optional_arg_p =
+        TREE_CODE (decl) == INDIRECT_REF
+      && TREE_CODE (TREE_OPERAND (decl, 0)) == PARM_DECL
+      && DECL_BY_REFERENCE (TREE_OPERAND (decl, 0))
+      && TREE_CODE (TREE_TYPE (TREE_OPERAND (decl, 0))) == POINTER_TYPE;
+      tree ptr;
+
+      if (optional_arg_p)
+ ptr = gfc_build_conditional_assign_expr (
+ &block,
+ TREE_OPERAND (decl, 0),
+ gfc_conv_descriptor_data_get (decl),
+ null_pointer_node);
+      else
+ ptr = gfc_conv_descriptor_data_get (decl);
        ptr = fold_convert (build_pointer_type (char_type_node), ptr);
        ptr = build_fold_indirect_ref (ptr);
        OMP_CLAUSE_DECL (c) = ptr;
        c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
        OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_TO_PSET);
-      OMP_CLAUSE_DECL (c2) = decl;
+      if (optional_arg_p)
+ {
+  ptr = create_tmp_var (TREE_TYPE (TREE_OPERAND (decl, 0)));
+  gfc_add_modify (&block, ptr, TREE_OPERAND (decl, 0));
+
+  OMP_CLAUSE_DECL (c2) = build_fold_indirect_ref (ptr);
+ }
+      else
+ OMP_CLAUSE_DECL (c2) = decl;
        OMP_CLAUSE_SIZE (c2) = TYPE_SIZE_UNIT (type);
        c3 = build_omp_clause (OMP_CLAUSE_LOCATION (c), OMP_CLAUSE_MAP);
        OMP_CLAUSE_SET_MAP_KIND (c3, GOMP_MAP_POINTER);
-      OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
+      if (optional_arg_p)
+ OMP_CLAUSE_DECL (c3) = gfc_build_conditional_assign_expr (
+ &block,
+ TREE_OPERAND (decl, 0),
+ gfc_conv_descriptor_data_get (decl),
+ null_pointer_node);
+      else
+ OMP_CLAUSE_DECL (c3) = gfc_conv_descriptor_data_get (decl);
        OMP_CLAUSE_SIZE (c3) = size_int (0);
        tree size = create_tmp_var (gfc_array_index_type);
        tree elemsz = TYPE_SIZE_UNIT (gfc_get_element_type (type));
@@ -1165,6 +1250,27 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
      void_type_node, cond,
      then_b, else_b));
  }
+      else if (optional_arg_p)
+ {
+  stmtblock_t cond_block;
+  tree then_b;
+
+  gfc_init_block (&cond_block);
+  gfc_add_modify (&cond_block, size,
+  gfc_full_array_size (&cond_block, decl,
+       GFC_TYPE_ARRAY_RANK (type)));
+  gfc_add_modify (&cond_block, size,
+  fold_build2 (MULT_EXPR, gfc_array_index_type,
+       size, elemsz));
+  then_b = gfc_finish_block (&cond_block);
+
+  gfc_build_conditional_assign (
+  &block,
+  size,
+  TREE_OPERAND (decl, 0),
+  then_b,
+  build_int_cst (gfc_array_index_type, 0));
+ }
        else
  {
   gfc_add_modify (&block, size,
@@ -2171,7 +2277,17 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,
   if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
     {
       tree type = TREE_TYPE (decl);
-      tree ptr = gfc_conv_descriptor_data_get (decl);
+      tree ptr;
+
+      if (n->sym->attr.optional)
+ ptr = gfc_build_conditional_assign_expr (
+ block,
+ TREE_OPERAND (decl, 0),
+ gfc_conv_descriptor_data_get (decl),
+ null_pointer_node);
+      else
+ ptr = gfc_conv_descriptor_data_get (decl);
+
       ptr = fold_convert (build_pointer_type (char_type_node),
   ptr);
       ptr = build_fold_indirect_ref (ptr);
@@ -2190,34 +2306,30 @@ gfc_trans_omp_clauses (stmtblock_t *block,
gfc_omp_clauses *clauses,

       /* We have to check for n->sym->attr.dimension because
  of scalar coarrays.  */
-      if (n->sym->attr.pointer && n->sym->attr.dimension)
+      if ((n->sym->attr.pointer || n->sym->attr.optional)
+  && n->sym->attr.dimension)
  {
   stmtblock_t cond_block;
   tree size
     = gfc_create_var (gfc_array_index_type, NULL);
-  tree tem, then_b, else_b, zero, cond;
+  tree cond = n->sym->attr.optional
+      ? TREE_OPERAND (decl, 0)
+      : gfc_conv_descriptor_data_get (decl);

   gfc_init_block (&cond_block);
-  tem
-    = gfc_full_array_size (&cond_block, decl,
-   GFC_TYPE_ARRAY_RANK (type));
-  gfc_add_modify (&cond_block, size, tem);
-  then_b = gfc_finish_block (&cond_block);
-  gfc_init_block (&cond_block);
-  zero = build_int_cst (gfc_array_index_type, 0);
-  gfc_add_modify (&cond_block, size, zero);
-  else_b = gfc_finish_block (&cond_block);
-  tem = gfc_conv_descriptor_data_get (decl);
-  tem = fold_convert (pvoid_type_node, tem);
-  cond = fold_build2_loc (input_location, NE_EXPR,
-  logical_type_node,
-  tem, null_pointer_node);
-  gfc_add_expr_to_block (block,
- build3_loc (input_location,
-     COND_EXPR,
-     void_type_node,
-     cond, then_b,
-     else_b));
+  gfc_add_modify (&cond_block, size,
+  gfc_full_array_size (
+      &cond_block, decl,
+      GFC_TYPE_ARRAY_RANK (type)));
+  tree then_b = gfc_finish_block (&cond_block);
+
+  gfc_build_conditional_assign (
+  block,
+  size,
+  cond,
+  then_b,
+  build_int_cst (gfc_array_index_type, 0));
+
   OMP_CLAUSE_SIZE (node) = size;
  }
       else if (n->sym->attr.dimension)
--
2.8.1

[Kwok Cheung Yeung]

This patch fixes a similar situation that occurs with the use_device
clause, where the lowering would result in a null dereference if applied
to a non-present optional argument. This patch builds a conditional
check that skips the dereference if the argument is non-present, and
ensures that optional arguments are treated like references.

        gcc/
        * omp-low.c (lower_omp_target): For use_device clauses, generate
        conditional statements to treat Fortran optional arguments like
        references if non-null, or propogate null arguments into offloaded
        code otherwise.
---
  gcc/omp-low.c | 77
+++++++++++++++++++++++++++++++++++++++++++++++++++++++----
  1 file changed, 73 insertions(+), 4 deletions(-)

diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 625df1e..2dfeca5 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -11635,18 +11635,51 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
       tkind = GOMP_MAP_FIRSTPRIVATE_INT;
     type = TREE_TYPE (ovar);
     if (TREE_CODE (type) == ARRAY_TYPE)
-      var = build_fold_addr_expr (var);
+      {
+ var = build_fold_addr_expr (var);
+ gimplify_assign (x, var, &ilist);
+      }
     else
       {
- if (omp_is_reference (ovar))
+ tree opt_arg_label;
+ bool optional_arg_p = omp_is_optional_argument (ovar);
+
+ if (optional_arg_p)
+  {
+    tree null_label
+      = create_artificial_label (UNKNOWN_LOCATION);
+    tree notnull_label
+      = create_artificial_label (UNKNOWN_LOCATION);
+    opt_arg_label
+      = create_artificial_label (UNKNOWN_LOCATION);
+    tree new_x = copy_node (x);
+    gcond *cond = gimple_build_cond (EQ_EXPR, ovar,
+     null_pointer_node,
+     null_label,
+     notnull_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));
+  }
+
+ if (omp_is_reference (ovar) || optional_arg_p)
   {
     type = TREE_TYPE (type);
     if (TREE_CODE (type) != ARRAY_TYPE)
       var = build_simple_mem_ref (var);
     var = fold_convert (TREE_TYPE (x), var);
   }
+
+ gimplify_assign (x, var, &ilist);
+ if (optional_arg_p)
+  gimple_seq_add_stmt (&ilist,
+       gimple_build_label (opt_arg_label));
       }
-    gimplify_assign (x, var, &ilist);
     s = size_int (0);
     purpose = size_int (map_idx++);
     CONSTRUCTOR_APPEND_ELT (vsize, purpose, s);
@@ -11828,11 +11861,43 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
       {
  tree type = TREE_TYPE (var);
  tree new_var = lookup_decl (var, ctx);
- if (omp_is_reference (var))
+ tree opt_arg_label = NULL_TREE;
+
+ if (omp_is_reference (var) || omp_is_optional_argument (var))
   {
     type = TREE_TYPE (type);
     if (TREE_CODE (type) != ARRAY_TYPE)
       {
+ if (omp_is_optional_argument (var))
+  {
+    tree null_label
+      = create_artificial_label (UNKNOWN_LOCATION);
+    tree notnull_label
+      = create_artificial_label (UNKNOWN_LOCATION);
+    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);
+    gcond *cond;
+
+    gimplify_expr (&x, &new_body, NULL, is_gimple_val,
+   fb_rvalue);
+    cond = gimple_build_cond (EQ_EXPR, x,
+      null_pointer_node,
+      null_label,
+      notnull_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);
+  }
+
  tree v = create_tmp_var_raw (type, get_name (var));
  gimple_add_tmp_var (v);
  TREE_ADDRESSABLE (v) = 1;
@@ -11849,6 +11914,10 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
omp_context *ctx)
  gimplify_expr (&x, &new_body, NULL, is_gimple_val, fb_rvalue);
  gimple_seq_add_stmt (&new_body,
      gimple_build_assign (new_var, x));
+
+ if (opt_arg_label != NULL_TREE)
+  gimple_seq_add_stmt (&new_body,
+       gimple_build_label (opt_arg_label));
       }
     break;
   }
--
2.8.1

[Jakub Jelinek]

On Fri, Jul 12, 2019 at 12:36:13PM +0100, Kwok Cheung Yeung wrote:

> --- a/gcc/omp-general.c
> +++ b/gcc/omp-general.c
> @@ -48,6 +48,20 @@ omp_find_clause (tree clauses, enum omp_clause_code kind)
>    return NULL_TREE;
>  }
>
> +/* Return true if DECL is a Fortran optional argument.  */
> +
> +bool
> +omp_is_optional_argument (tree decl)
> +{
> +  /* A passed-by-reference Fortran optional argument is similar to
> +     a normal argument, but since it can be null the type is a
> +     POINTER_TYPE rather than a REFERENCE_TYPE.  */
> +  return lang_GNU_Fortran ()
> +        && TREE_CODE (decl) == PARM_DECL
> +        && DECL_BY_REFERENCE (decl)
> + && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE;
> +}

This should be done through a langhook.
Are really all PARM_DECLs wtih DECL_BY_REFERENCE and pointer type optional
arguments?  I mean, POINTER_TYPE is used for a lot of cases.

        Jakub

[Tobias Burnus]

Am 17.07.19 um 19:53 schrieb Kwok Cheung Yeung:

> On 12/07/2019 12:41 pm, Jakub Jelinek wrote:
>> This should be done through a langhook.
>> Are really all PARM_DECLs wtih DECL_BY_REFERENCE and pointer type
>> optional
>> arguments?  I mean, POINTER_TYPE is used for a lot of cases.
>
> Hmmm... I thought it was the case that if you pass an argument in by
> reference (the default) in Fortran, the PARM_DECL will always be a
> reference to the argument type if non-optional, or a pointer if
> optional. However, fixed-shape arrays are passed in via a pointer
> whether optional or not...

[I have to admit that I have not yet read the OpenACC (nor OpenMP 5)
spec to know the semantics and whether it matters if something is a true
pointer or just optional.]


The following is a rather special case (matching a C "void *" pointer),
which is useless without later casting the argument ("c_f_pointer"
call), but it is a pointer argument which is not by reference and not
optional.


use iso_c_binding
implicit none
call foo(c_null_ptr)
contains
  subroutine foo(x)
    type(c_ptr), value :: x ! Matches a C 'void *' pointer
  end subroutine foo
end

Maybe there are more methods, but that requires some pondering.


> In the Fortran FE, optional arguments are indicated by setting
> attr.optional on the gfc_symbol for the parameter, but the OMP
> lowering works on a tree - is it somehow possible to get from the tree
> back to the gfc_symbol? If so, that would be a more reliable method of
> detecting optional arguments.

The gfc_symbol etc. is gone. The only possibility is to store some extra
data in the language-dependent part of the tree, i.e. using
DECL_LANG_SPECIFIC. Cf. lang_decl in trans.h and the various #defines
which use DECL_LANG_SPECIFIC.

Cheers,

Tobias

[Kwok Cheung Yeung]

On 18/07/2019 10:28 am, Tobias Burnus wrote:

> Hi all,
>
> I played around and came up with another second way one gets a single "*" without
> 'optional'.
>
> I haven't checked whether which of those match the proposed omp_is_optional_argument's
> +        && DECL_BY_REFERENCE (decl)
> + && TREE_CODE (TREE_TYPE (decl)) == POINTER_TYPE;
> nor whether some checks reject any of those with OpenACC (or OpenMP).
>
> In any case, the dump of "type(c_ptr),value", "integer, dimension(1)" and "integer,optional"
> is:
>
> static void foo (void *, integer(kind=4)[1] *, integer(kind=4) *);
>

The case of the fixed-length array currently doesn't work properly with
omp_is_optional_argument, as it returns true whether or not it is optional.
Indeed, the PARM_DECL doesn't seem to change between optional and non-optional,
so it is probably impossible to discern via the tree unless some extra
information is added by the front-end.

However, optional arrays still 'just work' with my patches (most of the
testcases include tests for arrays in optional arguments). I believe this is
because the existing code must already deal with pointers to arrays, so the
false positive simply does not matter on the codepath taken. The new case of a
null pointer (in the case of a non-present optional argument) was dealt with by
making operations on null pointers into NOPs.

>
> Actually, if one combines VALUE with OPTIONAL, it gets even more interesting.
> To implement it, one has two choices:
> * pass a copy by reference (or NULL)
> * pass by value (including a dummy value if absent) and denote the state as
>    extra argument.
>
> The latter is done in gfortran, cf. PR fortran/35203, following the IBM compiler.
>
>
> I am not sure whether it does need special care fore OpenACC (or OpenMP 5) offloading,
> but that's at least a case which is not handled by the patch.
>

Optional by-value arguments are tested in optional-data-copyin-by-value.f90.
They do not need extra handling, since from the OACC lowering perspective they
are just two bog-standard integral values of no special interest.

Kwok

[Jakub Jelinek]

On Mon, Jul 29, 2019 at 10:00:53PM +0100, Kwok Cheung Yeung wrote:

> --- a/gcc/omp-low.c
> +++ b/gcc/omp-low.c
> @@ -11636,9 +11636,40 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
> omp_context *ctx)
>        tkind = GOMP_MAP_FIRSTPRIVATE_INT;
>      type = TREE_TYPE (ovar);
>      if (TREE_CODE (type) == ARRAY_TYPE)
> -      var = build_fold_addr_expr (var);
> +      {
> + var = build_fold_addr_expr (var);
> + gimplify_assign (x, var, &ilist);
> +      }
>      else
>        {
> + tree opt_arg_label;
> + bool optional_arg_p
> +  = TREE_CODE (TREE_TYPE (ovar)) == POINTER_TYPE
> +    && omp_is_optional_argument (ovar);

This should be also wrapped in ()s for emacs, like:

                bool optional_arg_p
                  = (TREE_CODE (TREE_TYPE (ovar)) == POINTER_TYPE
                     && omp_is_optional_argument (ovar));

> +
> + if (optional_arg_p)
> +  {
> +    tree null_label
> +      = create_artificial_label (UNKNOWN_LOCATION);
> +    tree notnull_label
> +      = create_artificial_label (UNKNOWN_LOCATION);
> +    opt_arg_label
> +      = create_artificial_label (UNKNOWN_LOCATION);
> +    tree new_x = copy_node (x);

Please use unshare_expr instead of copy_node here.

Otherwise LGTM.

On the OpenMP side this isn't sufficient, because it only
handles mapping clauses, not the data sharing, so I guess I'll need to go
through all data sharing clauses on all constructs, write testcases and see
if what OpenMP spec says (just a general rule):
"If a list item that appears in a directive or clause is an optional dummy argument that is not present,
the directive or clause for that list item is ignored.

If the variable referenced inside a construct is an optional dummy argument that is not present, any
explicitly determined, implicitly determined, or predetermined data-sharing and data-mapping
attribute rules for that variable are ignored. Otherwise, if the variable is an optional dummy
argument that is present, it is present inside the construct."
is handled right.

        Jakub

[Thomas Schwinge-8]

Hi Kwok, Tobias!

On 2019-07-29T21:55:52+0100, Kwok Cheung Yeung <[hidden email]> wrote:
>  >   if (omp_is_reference (new_var)
>  >    && TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE)
>
> As is, this code in lower_omp_target will always reject optional arguments, so
> it must be changed. This was introduced in commit r261025 (SVN trunk) as a fix
> for PR 85879, but it also breaks support for arrays in firstprivate, which was
> probably an unintended side-effect.

Do we have sufficient testsuite coverage for "arrays in firstprivate", in
all languages?


Grüße
 Thomas


> I have found that allowing POINTER_TYPEs
> that are also DECL_BY_REFERENCE through in this condition allows both optional
> arguments and arrays to work without regressing the tests in r261025.

> * omp-low.c (lower_omp_target): Create temporary for received value
> and take the address for new_var if the original variable was a
> DECL_BY_REFERENCE.  [...]

> --- a/gcc/omp-low.c
> +++ b/gcc/omp-low.c
> @@ -11173,7 +11173,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p,
> omp_context *ctx)
>        {
>   gcc_assert (is_gimple_omp_oacc (ctx->stmt));
>   if (omp_is_reference (new_var)
> -    && TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE)
> +    && (TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE
> +        || DECL_BY_REFERENCE (var)))
>    {
>      /* Create a local object to hold the instance
>         value.  */

Grüße
 Thomas

[Kwok Cheung Yeung]

On 07/10/2019 10:25 am, Thomas Schwinge wrote:

> Hi Kwok, Tobias!
>
> On 2019-07-29T21:55:52+0100, Kwok Cheung Yeung <[hidden email]> wrote:
>>   >   if (omp_is_reference (new_var)
>>   >    && TREE_CODE (TREE_TYPE (new_var)) != POINTER_TYPE)
>>
>> As is, this code in lower_omp_target will always reject optional arguments, so
>> it must be changed. This was introduced in commit r261025 (SVN trunk) as a fix
>> for PR 85879, but it also breaks support for arrays in firstprivate, which was
>> probably an unintended side-effect.
>
> Do we have sufficient testsuite coverage for "arrays in firstprivate", in
> all languages?
>

I don't know about other languages, but for Fortran, definitely not. The
only testcase that exercises this AFAIK is optional-firstprivate.f90 in
part 5 of this patch series.

Kwok