OpenMP] use_device_addr/use_device_ptr with Fortran allocatable/pointer arrays

        gcc/fortran/
        * f95-lang.c (LANG_HOOKS_OMP_ARRAY_DATA): Set to gfc_omp_array_data.
        * trans-array.c (gfc_conv_descriptor_data_get): Handle also
        REFERENCE_TYPE.
        * trans-openmp.c (gfc_omp_array_data): New.
        * trans.h (gfc_omp_array_data): New prototype.

        gcc/
        * hooks.c (hook_tree_tree_bool_null): New.
        * hooks.h (hook_tree_tree_bool_null): Declare.
        * langhooks-def.h (LANG_HOOKS_OMP_ARRAY_DATA): Define.
        (LANG_HOOKS_DECLS): Add it.
        * langhooks.h (lang_hooks_for_decls): Add omp_array_data.
        * omp-low.c (install_var_field): New mode for Fortran descriptor arrays.
        (lower_omp_target): Handle Fortran array with descriptor in
        OMP_CLAUSE_USE_DEVICE_ADDR/OMP_CLAUSE_USE_DEVICE_PTR.

        libgomp/
        * testsuite/libgomp.fortran/use_device_addr-1.f90 (test_nullptr_1,
        test_dummy_opt_nullptr_callee_1): Add present but unallocated test.
        * testsuite/libgomp.fortran/use_device_addr-2.f90: Likewise.
        * testsuite/libgomp.fortran/use_device_addr-3.f90: New.
        * testsuite/libgomp.fortran/use_device_addr-4.f90: New.
        * testsuite/testsuite/libgomp.fortran/use_device_ptr-1.f90: New.

From-SVN: r277705

11 files changed, 140 insertions, 13 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index affa74cdd25..08d3ba0232c 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,14 @@
+2019-11-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	* hooks.c (hook_tree_tree_bool_null): New.
+	* hooks.h (hook_tree_tree_bool_null): Declare.
+	* langhooks-def.h (LANG_HOOKS_OMP_ARRAY_DATA): Define.
+	(LANG_HOOKS_DECLS): Add it.
+	* langhooks.h (lang_hooks_for_decls): Add omp_array_data.
+	* omp-low.c (install_var_field): New mode for Fortran descriptor arrays.
+	(lower_omp_target): Handle Fortran array with descriptor in
+	OMP_CLAUSE_USE_DEVICE_ADDR/OMP_CLAUSE_USE_DEVICE_PTR.
+
 2019-10-31  Richard Sandiford  <richard.sandiford@arm.com>
 
 	* config/aarch64/aarch64-sve-builtins.cc (register_builtin_types):
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6cd05d130b1..be8ae58f685 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2019-11-01  Tobias Burnus  <tobias@codesourcery.com>
+
+	* f95-lang.c (LANG_HOOKS_OMP_ARRAY_DATA): Set to gfc_omp_array_data.
+	* trans-array.c (gfc_conv_descriptor_data_get): Handle also
+	REFERENCE_TYPE.
+	* trans-openmp.c (gfc_omp_array_data): New.
+	* trans.h (gfc_omp_array_data): New prototype.
+
 2019-10-31  Tobias Burnus  <tobias@codesourcery.com>
 
 	PR fortran/92284.
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 0f72ab9e3b4..0684c3b99cf 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -113,6 +113,7 @@ static const struct attribute_spec gfc_attribute_table[] =
 #undef LANG_HOOKS_TYPE_FOR_MODE
 #undef LANG_HOOKS_TYPE_FOR_SIZE
 #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_PRIVATIZE_BY_REFERENCE
@@ -147,6 +148,7 @@ static const struct attribute_spec gfc_attribute_table[] =
 #define LANG_HOOKS_TYPE_FOR_MODE	gfc_type_for_mode
 #define LANG_HOOKS_TYPE_FOR_SIZE	gfc_type_for_size
 #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_PRIVATIZE_BY_REFERENCE	gfc_omp_privatize_by_reference
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2d85bf78c42..685f8c5a874 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -142,6 +142,9 @@ gfc_conv_descriptor_data_get (tree desc)
   tree field, type, t;
 
   type = TREE_TYPE (desc);
+  if (TREE_CODE (type) == REFERENCE_TYPE)
+    type = TREE_TYPE (type);
+
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
 
   field = TYPE_FIELDS (type);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index dad11a24430..14a3c3e4284 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -71,6 +71,33 @@ gfc_omp_is_optional_argument (const_tree decl)
 	  && GFC_DECL_OPTIONAL_ARGUMENT (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
+   TREE_TYPE without creating a new tree.  */
+
+tree
+gfc_omp_array_data (tree decl, bool type_only)
+{
+  tree type = TREE_TYPE (decl);
+
+  if (POINTER_TYPE_P (type))
+    type = TREE_TYPE (type);
+
+  if (!GFC_DESCRIPTOR_TYPE_P (type))
+    return NULL_TREE;
+
+  if (type_only)
+    return GFC_TYPE_ARRAY_DATAPTR_TYPE (type);
+
+  if (POINTER_TYPE_P (TREE_TYPE (decl)))
+    decl = build_fold_indirect_ref (decl);
+
+  decl = gfc_conv_descriptor_data_get (decl);
+  STRIP_NOPS (decl);
+  return decl;
+}
+
 /* True if OpenMP should privatize what this DECL points to rather
    than the DECL itself.  */
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index e96b22acc68..364efe51d7c 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -788,6 +788,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_array_data (tree, bool);
 bool gfc_omp_privatize_by_reference (const_tree);
 enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);
 tree gfc_omp_report_decl (tree);
diff --git a/gcc/hooks.c b/gcc/hooks.c
index a9a87de3cdb..8e4578d624d 100644
--- a/gcc/hooks.c
+++ b/gcc/hooks.c
@@ -430,6 +430,12 @@ hook_tree_tree_int_treep_bool_null (tree, int, tree *, bool)
 }
 
 tree
+hook_tree_tree_bool_null (tree, bool)
+{
+  return NULL;
+}
+
+tree
 hook_tree_tree_tree_null (tree, tree)
 {
   return NULL;
diff --git a/gcc/hooks.h b/gcc/hooks.h
index 7cfe91d12df..d5269536357 100644
--- a/gcc/hooks.h
+++ b/gcc/hooks.h
@@ -106,6 +106,7 @@ extern HOST_WIDE_INT hook_hwi_void_0 (void);
 extern tree hook_tree_const_tree_null (const_tree);
 extern tree hook_tree_void_null (void);
 
+extern tree hook_tree_tree_bool_null (tree, bool);
 extern tree hook_tree_tree_tree_null (tree, tree);
 extern tree hook_tree_tree_tree_tree_null (tree, tree, tree);
 extern tree hook_tree_tree_int_treep_bool_null (tree, int, tree *, bool);
diff --git a/gcc/langhooks-def.h b/gcc/langhooks-def.h
index 54f80e51f8c..2d3ad9a0a76 100644
--- a/gcc/langhooks-def.h
+++ b/gcc/langhooks-def.h
@@ -239,6 +239,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
 #define LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL lhd_warn_unused_global_decl
 #define LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS NULL
 #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_PRIVATIZE_BY_REFERENCE hook_bool_const_tree_false
@@ -266,6 +267,7 @@ extern tree lhd_unit_size_without_reusable_padding (tree);
   LANG_HOOKS_WARN_UNUSED_GLOBAL_DECL, \
   LANG_HOOKS_POST_COMPILATION_PARSING_CLEANUPS, \
   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_PRIVATIZE_BY_REFERENCE, \
diff --git a/gcc/langhooks.h b/gcc/langhooks.h
index e50162f9482..39d3608b5f8 100644
--- a/gcc/langhooks.h
+++ b/gcc/langhooks.h
@@ -226,6 +226,11 @@ struct lang_hooks_for_decls
   /* True if this decl may be called via a sibcall.  */
   bool (*ok_for_sibcall) (const_tree);
 
+  /* Return a tree for the actual data of an array descriptor - or NULL_TREE
+     if original tree is not an array descriptor.  If the the second argument
+     is true, only the TREE_TYPE is returned without generating a new tree.  */
+  tree (*omp_array_data) (tree, bool);
+
   /* True if OpenMP should regard this DECL as being a scalar which has Fortran's
      allocatable or pointer attribute.  */
   bool (*omp_is_allocatable_or_ptr) (const_tree);
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index 279b6ef893a..cd7da6da0ef 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -715,6 +715,11 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx)
   tree field, type, sfield = NULL_TREE;
   splay_tree_key key = (splay_tree_key) var;
 
+  if ((mask & 16) != 0)
+    {
+      key = (splay_tree_key) &DECL_NAME (var);
+      gcc_checking_assert (key != (splay_tree_key) var);
+    }
   if ((mask & 8) != 0)
     {
       key = (splay_tree_key) &DECL_UID (var);
@@ -728,6 +733,9 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx)
 	      || !is_gimple_omp_oacc (ctx->stmt));
 
   type = TREE_TYPE (var);
+  if ((mask & 16) != 0)
+    type = lang_hooks.decls.omp_array_data (var, true);
+
   /* Prevent redeclaring the var in the split-off function with a restrict
      pointer type.  Note that we only clear type itself, restrict qualifiers in
      the pointed-to type will be ignored by points-to analysis.  */
@@ -752,7 +760,7 @@ install_var_field (tree var, bool by_ref, int mask, omp_context *ctx)
      side effect of making dwarf2out ignore this member, so for helpful
      debugging we clear it later in delete_omp_context.  */
   DECL_ABSTRACT_ORIGIN (field) = var;
-  if (type == TREE_TYPE (var))
+  if ((mask & 16) == 0 && type == TREE_TYPE (var))
     {
       SET_DECL_ALIGN (field, DECL_ALIGN (var));
       DECL_USER_ALIGN (field) = DECL_USER_ALIGN (var);
@@ -1240,10 +1248,14 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
 	case OMP_CLAUSE_USE_DEVICE_PTR:
 	case OMP_CLAUSE_USE_DEVICE_ADDR:
 	  decl = OMP_CLAUSE_DECL (c);
-	  if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
-	       && !omp_is_reference (decl)
-	       && !omp_is_allocatable_or_ptr (decl))
-	      || TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
+
+	  /* Fortran array descriptors.  */
+	  if (lang_hooks.decls.omp_array_data (decl, true))
+	    install_var_field (decl, false, 19, ctx);
+	  else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
+		    && !omp_is_reference (decl)
+		    && !omp_is_allocatable_or_ptr (decl))
+		   || TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
 	    install_var_field (decl, true, 11, ctx);
 	  else
 	    install_var_field (decl, false, 11, ctx);
@@ -11485,7 +11497,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	  }
 	else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
 		  && !omp_is_reference (var)
-		  && !omp_is_allocatable_or_ptr (var))
+		  && !omp_is_allocatable_or_ptr (var)
+		  && !lang_hooks.decls.omp_array_data (var, true))
 		 || TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
 	  {
 	    tree new_var = lookup_decl (var, ctx);
@@ -11866,7 +11879,14 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	  case OMP_CLAUSE_IS_DEVICE_PTR:
 	    ovar = OMP_CLAUSE_DECL (c);
 	    var = lookup_decl_in_outer_ctx (ovar, ctx);
-	    if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR)
+
+	    if (lang_hooks.decls.omp_array_data (ovar, true))
+	      {
+		tkind = (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR
+			 ? GOMP_MAP_USE_DEVICE_PTR : GOMP_MAP_FIRSTPRIVATE_INT);
+		x = build_sender_ref ((splay_tree_key) &DECL_NAME (ovar), ctx);
+	      }
+	    else if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR)
 	      {
 		tkind = GOMP_MAP_USE_DEVICE_PTR;
 		x = build_sender_ref ((splay_tree_key) &DECL_UID (ovar), ctx);
@@ -11877,10 +11897,12 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 		x = build_sender_ref (ovar, ctx);
 	      }
 	    type = TREE_TYPE (ovar);
-	    if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
-		 && !omp_is_reference (ovar)
-		 && !omp_is_allocatable_or_ptr (ovar))
-		|| TREE_CODE (type) == ARRAY_TYPE)
+	    if (lang_hooks.decls.omp_array_data (ovar, 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))
+		     || TREE_CODE (type) == ARRAY_TYPE)
 	      var = build_fold_addr_expr (var);
 	    else
 	      {
@@ -12048,11 +12070,50 @@ 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);
+	    bool is_array_data;
+	    is_array_data = lang_hooks.decls.omp_array_data (var, true) != NULL;
+
 	    if (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_IS_DEVICE_PTR)
-	      x = build_sender_ref ((splay_tree_key) &DECL_UID (var), ctx);
+	      x = build_sender_ref (is_array_data
+				    ? (splay_tree_key) &DECL_NAME (var)
+				    : (splay_tree_key) &DECL_UID (var), ctx);
 	    else
 	      x = build_receiver_ref (var, false, ctx);
-	    if (is_variable_sized (var))
+
+	    if (is_array_data)
+	      {
+		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 = 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,
+				   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_build_assign (v, var));
+		    tree rhs = build_fold_addr_expr (v);
+		    gimple_seq_add_stmt (&new_body,
+					 gimple_build_assign (new_var, rhs));
+		  }
+		else
+		  gimple_seq_add_stmt (&new_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,
+				     gimple_build_assign (v2, x));
+	      }
+	    else if (is_variable_sized (var))
 	      {
 		tree pvar = DECL_VALUE_EXPR (var);
 		gcc_assert (TREE_CODE (pvar) == INDIRECT_REF);