Fortran] Support absent optional args with use_device_{ptr,addr}

2019-11-11  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-expr.c (gfc_conv_expr_present): Check for DECL_ARTIFICIAL
        for the VALUE hidden argument avoiding -fallow-underscore issues.
        * 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-1.f90: Extend.
        * testsuite/libgomp.fortran/use_device_ptr-optional-2.f90: New.


Co-Authored-By: Kwok Cheung Yeung <kcy@codesourcery.com>

From-SVN: r278046

1 files changed, 58 insertions, 5 deletions

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 14a3c3e..dee7cc2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -58,19 +58,72 @@ 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
+	    && DECL_ARTIFICIAL (decl))
+	  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