[OpenMP,Fortran] Fix several OpenMP use_device_addr/map/update errors

	gcc/fortran/
	* f95-lang.c (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Re-define to
	gfc_omp_is_allocatable_or_ptr.
	* trans-decl.c (create_function_arglist): Set GFC_DECL_OPTIONAL_ARGUMENT
	only if not passed by value.
	* trans-openmp.c (gfc_omp_is_allocatable_or_ptr): New.
	(gfc_trans_omp_clauses): For MAP, handle (present) optional arguments;
	for target update, handle allocatable/pointer scalars.
	* trans.h (gfc_omp_is_allocatable_or_ptr): Declare.

	gcc/
	* langhooks-def.h (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Define.
	(LANG_HOOKS_DECLS): Add it.
	* langhooks.h (lang_hooks_for_decls): Add omp_is_allocatable_or_ptr;
	update comment for omp_is_optional_argument.
	* omp-general.c (omp_is_allocatable_or_ptr): New.
	* omp-general.h (omp_is_allocatable_or_ptr): Declare.
	* omp-low.c (scan_sharing_clauses, lower_omp_target): Handle
	Fortran's optional arguments and allocatable/pointer scalars
	with use_device_addr.

	libgomp/
	* testsuite/libgomp.fortran/use_device_addr-1.f90: New.
	* testsuite/libgomp.fortran/use_device_addr-2.f90: New.

From-SVN: r276875

gcc/ChangeLog

+2019-10-11  Tobias Burnus  <tobias@codesourcery.com>
+
+	* langhooks-def.h (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Define.
+	(LANG_HOOKS_DECLS): Add it.
+	* langhooks.h (lang_hooks_for_decls): Add omp_is_allocatable_or_ptr;
+	update comment for omp_is_optional_argument.
+	* omp-general.c (omp_is_allocatable_or_ptr): New.
+	* omp-general.h (omp_is_allocatable_or_ptr): Declare.
+	* omp-low.c (scan_sharing_clauses, lower_omp_target): Handle
+	Fortran's optional arguments and allocatable/pointer scalars
+	with use_device_addr.
+
 2019-10-11  Ilya Leoshkevich  <iii@linux.ibm.com>
 
 	PR target/77918

gcc/fortran/ChangeLog

+2019-10-11  Tobias Burnus  <tobias@codesourcery.com>
+
+	* f95-lang.c (LANG_HOOKS_OMP_IS_ALLOCATABLE_OR_PTR): Re-define to
+	gfc_omp_is_allocatable_or_ptr.
+	* trans-decl.c (create_function_arglist): Set GFC_DECL_OPTIONAL_ARGUMENT
+	only if not passed by value.
+	* trans-openmp.c (gfc_omp_is_allocatable_or_ptr): New.
+	(gfc_trans_omp_clauses): For MAP, handle (present) optional arguments;
+	for target update, handle allocatable/pointer scalars.
+	* trans.h (gfc_omp_is_allocatable_or_ptr): Declare.
+
 2019-10-10  Tobias Burnus  <tobias@codesourcery.com>
 
 	* trans-openmp.c (gfc_trans_omp_clauses): Actually pass use_device_addr

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_IS_ALLOCATABLE_OR_PTR
 #undef LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT
 #undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
 #undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
@@ -146,6 +147,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_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
 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING	gfc_omp_predetermined_sharing

gcc/fortran/trans-decl.c

@@ -2691,8 +2691,9 @@ create_function_arglist (gfc_symbol * sym)
 	  && (!f->sym->attr.proc_pointer
 	      && f->sym->attr.flavor != FL_PROCEDURE))
 	DECL_BY_REFERENCE (parm) = 1;
-      if (f->sym->attr.optional)
+      if (f->sym->attr.optional && !f->sym->attr.value)
 	{
+	  /* With value, the argument is passed as is.  */
 	  gfc_allocate_lang_decl (parm);
 	  GFC_DECL_OPTIONAL_ARGUMENT (parm) = 1;
 	}

gcc/fortran/trans-openmp.c

@@ -47,7 +47,21 @@ along with GCC; see the file COPYING3.  If not see
 
 int ompws_flags;
 
-/* True if OpenMP should treat this DECL as an optional argument.  */
+/* True if OpenMP should regard this DECL as being a scalar which has Fortran's
+   allocatable or pointer attribute.  */
+
+bool
+gfc_omp_is_allocatable_or_ptr (const_tree decl)
+{
+  return (DECL_P (decl)
+	  && (GFC_DECL_GET_SCALAR_POINTER (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.  */
 
 bool
 gfc_omp_is_optional_argument (const_tree decl)
@@ -2173,7 +2187,8 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      OMP_CLAUSE_DECL (node4) = decl;
 		      OMP_CLAUSE_SIZE (node4) = size_int (0);
 		      decl = build_fold_indirect_ref (decl);
-		      if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
+		      if ((TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
+			   || gfc_omp_is_optional_argument (orig_decl))
 			  && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
 			      || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
 			{
@@ -2417,7 +2432,11 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		{
 		  tree decl = gfc_trans_omp_variable (n->sym, false);
 		  if (gfc_omp_privatize_by_reference (decl))
-		    decl = build_fold_indirect_ref (decl);
+		    {
+		      if (gfc_omp_is_allocatable_or_ptr (decl))
+			decl = build_fold_indirect_ref (decl);
+		      decl = build_fold_indirect_ref (decl);
+		    }
 		  else if (DECL_P (decl))
 		    TREE_ADDRESSABLE (decl) = 1;
 		  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
@@ -2439,7 +2458,12 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 				       OMP_CLAUSE_SIZE (node), elemsz);
 		    }
 		  else
-		    OMP_CLAUSE_DECL (node) = decl;
+		    {
+		      OMP_CLAUSE_DECL (node) = decl;
+		      if (gfc_omp_is_allocatable_or_ptr (decl))
+			OMP_CLAUSE_SIZE (node)
+				= TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (decl)));
+		    }
 		}
 	      else
 		{

gcc/fortran/trans.h

@@ -786,6 +786,7 @@ struct array_descr_info;
 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);
 bool gfc_omp_privatize_by_reference (const_tree);
 enum omp_clause_default_kind gfc_omp_predetermined_sharing (tree);

gcc/langhooks-def.h

@@ -236,6 +236,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_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
 #define LANG_HOOKS_OMP_PREDETERMINED_SHARING lhd_omp_predetermined_sharing
@@ -262,6 +263,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_IS_ALLOCATABLE_OR_PTR, \
   LANG_HOOKS_OMP_IS_OPTIONAL_ARGUMENT, \
   LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE, \
   LANG_HOOKS_OMP_PREDETERMINED_SHARING, \

gcc/langhooks.h

@@ -222,7 +222,14 @@ struct lang_hooks_for_decls
   /* True if this decl may be called via a sibcall.  */
   bool (*ok_for_sibcall) (const_tree);
 
-  /* True if OpenMP should treat DECL as a Fortran optional argument.  */
+  /* 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);
+
+  /* True if OpenMP should treat DECL as a Fortran 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.  */
   bool (*omp_is_optional_argument) (const_tree);
 
   /* True if OpenMP should privatize what this DECL points to rather

gcc/omp-general.c

@@ -48,6 +48,14 @@ omp_find_clause (tree clauses, enum omp_clause_code kind)
   return NULL_TREE;
 }
 
+/* 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 (tree decl)
+{
+  return lang_hooks.decls.omp_is_allocatable_or_ptr (decl);
+}
+
 /* Return true if DECL is a Fortran optional argument.  */
 
 bool

gcc/omp-general.h

@@ -73,6 +73,7 @@ struct omp_for_data
 #define OACC_FN_ATTRIB "oacc function"
 
 extern tree omp_find_clause (tree clauses, enum omp_clause_code kind);
+extern bool omp_is_allocatable_or_ptr (tree decl);
 extern bool omp_is_optional_argument (tree decl);
 extern bool omp_is_reference (tree decl);
 extern void omp_adjust_for_condition (location_t loc, enum tree_code *cond_code,

gcc/omp-low.c

@@ -1241,7 +1241,8 @@ scan_sharing_clauses (tree clauses, omp_context *ctx)
 	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_reference (decl)
+	       && !omp_is_allocatable_or_ptr (decl))
 	      || TREE_CODE (TREE_TYPE (decl)) == ARRAY_TYPE)
 	    install_var_field (decl, true, 11, ctx);
 	  else
@@ -11483,7 +11484,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	    DECL_HAS_VALUE_EXPR_P (new_var) = 1;
 	  }
 	else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
-		  && !omp_is_reference (var))
+		  && !omp_is_reference (var)
+		  && !omp_is_allocatable_or_ptr (var))
 		 || TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
 	  {
 	    tree new_var = lookup_decl (var, ctx);
@@ -11678,7 +11680,18 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 		  }
 		else
 		  {
-		    var = build_fold_addr_expr (var);
+		    /* While MAP is handled explicitly by the FE,
+		       for 'target update', only the identified is passed.  */
+		    if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_FROM
+			 || OMP_CLAUSE_CODE (c) == OMP_CLAUSE_TO)
+			&& (omp_is_allocatable_or_ptr (var)
+			    && omp_is_optional_argument (var)))
+		      var = build_fold_indirect_ref (var);
+		    else if ((OMP_CLAUSE_CODE (c) != OMP_CLAUSE_FROM
+			      && OMP_CLAUSE_CODE (c) != OMP_CLAUSE_TO)
+			     || (!omp_is_allocatable_or_ptr (var)
+				 && !omp_is_optional_argument (var)))
+		      var = build_fold_addr_expr (var);
 		    gimplify_assign (x, var, &ilist);
 		  }
 	      }
@@ -11865,16 +11878,22 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	      }
 	    type = TREE_TYPE (ovar);
 	    if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
-		 && !omp_is_reference (ovar))
+		 && !omp_is_reference (ovar)
+		 && !omp_is_allocatable_or_ptr (ovar))
 		|| TREE_CODE (type) == ARRAY_TYPE)
 	      var = build_fold_addr_expr (var);
 	    else
 	      {
-		if (omp_is_reference (ovar) || omp_is_optional_argument (ovar))
+		if (omp_is_reference (ovar)
+		    || omp_is_optional_argument (ovar)
+		    || omp_is_allocatable_or_ptr (ovar))
 		  {
 		    type = TREE_TYPE (type);
 		    if (TREE_CODE (type) != ARRAY_TYPE
-			&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR)
+			&& ((OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR
+			    && !omp_is_allocatable_or_ptr (ovar))
+			   || (omp_is_reference (ovar)
+			       && omp_is_allocatable_or_ptr (ovar))))
 		      var = build_simple_mem_ref (var);
 		    var = fold_convert (TREE_TYPE (x), var);
 		  }
@@ -12045,7 +12064,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 				     gimple_build_assign (new_var, x));
 	      }
 	    else if ((OMP_CLAUSE_CODE (c) == OMP_CLAUSE_USE_DEVICE_ADDR
-		      && !omp_is_reference (var))
+		      && !omp_is_reference (var)
+		      && !omp_is_allocatable_or_ptr (var))
 		     || TREE_CODE (TREE_TYPE (var)) == ARRAY_TYPE)
 	      {
 		tree new_var = lookup_decl (var, ctx);
@@ -12065,7 +12085,9 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 		  {
 		    type = TREE_TYPE (type);
 		    if (TREE_CODE (type) != ARRAY_TYPE
-			&& OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR)
+			&& (OMP_CLAUSE_CODE (c) != OMP_CLAUSE_USE_DEVICE_ADDR
+			    || (omp_is_reference (var)
+				&& omp_is_allocatable_or_ptr (var))))
 		      {
 			tree v = create_tmp_var_raw (type, get_name (var));
 			gimple_add_tmp_var (v);

libgomp/ChangeLog

+2019-10-11  Tobias Burnus  <tobias@codesourcery.com>
+
+	* testsuite/libgomp.fortran/use_device_addr-1.f90: New.
+	* testsuite/libgomp.fortran/use_device_addr-2.f90: New.
+
 2019-10-09  Thomas Schwinge  <thomas@codesourcery.com>
 
 	PR middle-end/92036