[OpenMP/OpenACC/Fortran] Fix mapping of optional (present|absent) arguments

2019-12-06  Tobias Burnus  <tobias@codesourcery.com>
            Kwok Cheung Yeung <kcy@codesourcery.com>

        gcc/fortran/
        * trans-openmp.c (gfc_build_conditional_assign,
        gfc_build_conditional_assign_expr): New static functions.
        (gfc_omp_finish_clause, gfc_trans_omp_clauses): Handle mapping of
        absent optional arguments and fix mapping of present optional args.

        gcc/
        * omp-low.c (lower_omp_target): For optional arguments, deref once
        more to obtain the type.

        libgomp/
        * oacc-mem.c (update_dev_host, gomp_acc_insert_pointer): Just return
        if input it a NULL pointer.
        * testsuite/libgomp.oacc-c-c++-common/lib-43.c: Remove; dependent on
        diagnostic of NULL pointer.
        * testsuite/libgomp.oacc-c-c++-common/lib-47.c: Ditto.
        * testsuite/libgomp.fortran/optional-map.f90: New.
        * testsuite/libgomp.fortran/use_device_addr-1.f90
        (test_dummy_opt_callee_1_absent): New.
        (test_dummy_opt_call_1): Call it.
        * testsuite/libgomp.fortran/use_device_addr-2.f90: Likewise.
        * testsuite/libgomp.fortran/use_device_addr-3.f90: Likewise.
        * testsuite/libgomp.fortran/use_device_addr-4.f90: Likewise.
        * testsuite/libgomp.oacc-fortran/optional-cache.f95: New.
        * testsuite/libgomp.oacc-fortran/optional-data-copyin-by-value.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-data-copyin.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-data-copyout.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-declare.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-firstprivate.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-host_data.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-nested-calls.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-private.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-reduction.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-update-device.f90: New.
        * testsuite/libgomp.oacc-fortran/optional-update-host.f90: New.


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

From-SVN: r279043

4 files changed, 215 insertions, 12 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 1f0c2d1..ed7878c 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,9 @@
+2019-12-06  Tobias Burnus  <tobias@codesourcery.com>
+	    Kwok Cheung Yeung <kcy@codesourcery.com>
+
+	* omp-low.c (lower_omp_target): For optional arguments, deref once
+	more to obtain the type.
+
 2019-12-06  Richard Biener  <rguenther@suse.de>
 
 	* match.pd (nop_convert): Remove empty match.  Use nop_convert?
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 04861c7..682a10c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2019-12-06  Tobias Burnus  <tobias@codesourcery.com>
+	    Kwok Cheung Yeung <kcy@codesourcery.com>
+
+	* trans-openmp.c (gfc_build_conditional_assign, 
+	gfc_build_conditional_assign_expr): New static functions.
+	(gfc_omp_finish_clause, gfc_trans_omp_clauses): Handle mapping of
+	absent optional arguments and fix mapping of present optional args.
+
 2019-12-05  Tobias Burnus  <tobias@codesourcery.com>
 
 	* trans-openmp.c (gfc_omp_is_optional_argument,
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 2f9456d..0649a34 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1180,6 +1180,59 @@ 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_cond_assign (stmtblock_t *block, tree val, tree cond_val,
+		       tree then_b, tree else_val)
+{
+  stmtblock_t cond_block;
+  tree cond, else_b = NULL_TREE;
+  tree val_ty = TREE_TYPE (val);
+
+  if (else_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_build2_loc (input_location, NE_EXPR,
+			  logical_type_node,
+			  cond_val, 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_cond_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_cond_assign (block, val, cond_val, then_b, else_val);
+
+  return val;
+}
 
 void
 gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
@@ -1204,6 +1257,8 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
     }
 
   tree c2 = NULL_TREE, c3 = NULL_TREE, c4 = NULL_TREE;
+  tree present = (gfc_omp_is_optional_argument (decl)
+		  ? gfc_omp_check_optional_argument (decl, true) : NULL_TREE);
   if (POINTER_TYPE_P (TREE_TYPE (decl)))
     {
       if (!gfc_omp_privatize_by_reference (decl)
@@ -1218,8 +1273,30 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
       OMP_CLAUSE_DECL (c4) = decl;
       OMP_CLAUSE_SIZE (c4) = size_int (0);
       decl = build_fold_indirect_ref (decl);
-      OMP_CLAUSE_DECL (c) = decl;
-      OMP_CLAUSE_SIZE (c) = NULL_TREE;
+      if (present
+	  && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
+	      || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
+	{
+	  c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP);
+	  OMP_CLAUSE_SET_MAP_KIND (c2, GOMP_MAP_POINTER);
+	  OMP_CLAUSE_DECL (c2) = decl;
+	  OMP_CLAUSE_SIZE (c2) = size_int (0);
+
+	  stmtblock_t block;
+	  gfc_start_block (&block);
+	  tree ptr = decl;
+	  ptr = gfc_build_cond_assign_expr (&block, present, decl,
+					    null_pointer_node);
+	  gimplify_and_add (gfc_finish_block (&block), pre_p);
+	  ptr = build_fold_indirect_ref (ptr);
+	  OMP_CLAUSE_DECL (c) = ptr;
+	  OMP_CLAUSE_SIZE (c) = TYPE_SIZE_UNIT (TREE_TYPE (ptr));
+	}
+      else
+	{
+	  OMP_CLAUSE_DECL (c) = decl;
+	  OMP_CLAUSE_SIZE (c) = NULL_TREE;
+	}
       if (TREE_CODE (TREE_TYPE (orig_decl)) == REFERENCE_TYPE
 	  && (GFC_DECL_GET_SCALAR_POINTER (orig_decl)
 	      || GFC_DECL_GET_SCALAR_ALLOCATABLE (orig_decl)))
@@ -1238,16 +1315,38 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
       gfc_start_block (&block);
       tree type = TREE_TYPE (decl);
       tree ptr = gfc_conv_descriptor_data_get (decl);
+
+      if (present)
+	ptr = gfc_build_cond_assign_expr (&block, present, ptr,
+					  null_pointer_node);
       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 (present)
+	{
+	  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 (present)
+	{
+	  ptr = gfc_conv_descriptor_data_get (decl);
+	  ptr = gfc_build_addr_expr (NULL, ptr);
+	  ptr = gfc_build_cond_assign_expr (&block, present,
+					    ptr, null_pointer_node);
+	  ptr = build_fold_indirect_ref (ptr);
+	  OMP_CLAUSE_DECL (c3) = ptr;
+	}
+      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));
@@ -1273,11 +1372,35 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
 	  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);
+				  boolean_type_node, tem, null_pointer_node);
+	  if (present)
+	    {
+	      tem = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				     present, null_pointer_node);
+	      cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+				      boolean_type_node, tem, cond);
+	    }
 	  gfc_add_expr_to_block (&block, build3_loc (input_location, COND_EXPR,
 						     void_type_node, cond,
 						     then_b, else_b));
 	}
+      else if (present)
+	{
+	  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_cond_assign (&block, size, present, then_b,
+				 build_int_cst (gfc_array_index_type, 0));
+	}
       else
 	{
 	  gfc_add_modify (&block, size,
@@ -2257,6 +2380,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		TREE_ADDRESSABLE (decl) = 1;
 	      if (n->expr == NULL || n->expr->ref->u.ar.type == AR_FULL)
 		{
+		  tree present = (gfc_omp_is_optional_argument (decl)
+				  ? gfc_omp_check_optional_argument (decl, true)
+				  : NULL_TREE);
 		  if (POINTER_TYPE_P (TREE_TYPE (decl))
 		      && (gfc_omp_privatize_by_reference (decl)
 			  || GFC_DECL_GET_SCALAR_POINTER (decl)
@@ -2289,6 +2415,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		    {
 		      tree type = TREE_TYPE (decl);
 		      tree ptr = gfc_conv_descriptor_data_get (decl);
+		      if (present)
+			ptr = gfc_build_cond_assign_expr (block, present, ptr,
+							  null_pointer_node);
 		      ptr = fold_convert (build_pointer_type (char_type_node),
 					  ptr);
 		      ptr = build_fold_indirect_ref (ptr);
@@ -2301,8 +2430,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 		      node3 = build_omp_clause (input_location,
 						OMP_CLAUSE_MAP);
 		      OMP_CLAUSE_SET_MAP_KIND (node3, GOMP_MAP_POINTER);
-		      OMP_CLAUSE_DECL (node3)
-			= gfc_conv_descriptor_data_get (decl);
+		      if (present)
+			{
+			  ptr = gfc_conv_descriptor_data_get (decl);
+			  ptr = gfc_build_addr_expr (NULL, ptr);
+			  ptr = gfc_build_cond_assign_expr (block, present, ptr,
+							    null_pointer_node);
+			  ptr = build_fold_indirect_ref (ptr);
+			  OMP_CLAUSE_DECL (node3) = ptr;
+			}
+		      else
+			OMP_CLAUSE_DECL (node3)
+			  = gfc_conv_descriptor_data_get (decl);
 		      OMP_CLAUSE_SIZE (node3) = size_int (0);
 
 		      /* We have to check for n->sym->attr.dimension because
@@ -2327,8 +2466,20 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  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,
+						  boolean_type_node,
 						  tem, null_pointer_node);
+			  if (present)
+			    {
+			      tree tmp = fold_build2_loc (input_location,
+							  NE_EXPR,
+							  boolean_type_node,
+							  present,
+							  null_pointer_node);
+			      cond = fold_build2_loc (input_location,
+						      TRUTH_ANDIF_EXPR,
+						      boolean_type_node,
+						      tmp, cond);
+			    }
 			  gfc_add_expr_to_block (block,
 						 build3_loc (input_location,
 							     COND_EXPR,
@@ -2338,9 +2489,34 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 			  OMP_CLAUSE_SIZE (node) = size;
 			}
 		      else if (n->sym->attr.dimension)
-			OMP_CLAUSE_SIZE (node)
-			  = gfc_full_array_size (block, decl,
-						 GFC_TYPE_ARRAY_RANK (type));
+			{
+			  stmtblock_t cond_block;
+			  gfc_init_block (&cond_block);
+			  tree size = gfc_full_array_size (&cond_block, decl,
+					GFC_TYPE_ARRAY_RANK (type));
+			  if (present)
+			    {
+			      tree var = gfc_create_var (gfc_array_index_type,
+							 NULL);
+			      tree cond = fold_build2_loc (input_location,
+							   NE_EXPR,
+							   boolean_type_node,
+							   present,
+							   null_pointer_node);
+			      gfc_add_modify (&cond_block, var, size);
+			      cond = build3_loc (input_location, COND_EXPR,
+						 void_type_node, cond,
+						 gfc_finish_block (&cond_block),
+						 NULL_TREE);
+			      gfc_add_expr_to_block (block, cond);
+			      OMP_CLAUSE_SIZE (node) = var;
+			    }
+			  else
+			    {
+			      gfc_add_block_to_block (block, &cond_block);
+			      OMP_CLAUSE_SIZE (node) = size;
+			    }
+			}
 		      if (n->sym->attr.dimension)
 			{
 			  tree elemsz
@@ -2351,6 +2527,18 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
 					   OMP_CLAUSE_SIZE (node), elemsz);
 			}
 		    }
+		  else if (present
+			   && TREE_CODE (decl) == INDIRECT_REF
+			   && (TREE_CODE (TREE_OPERAND (decl, 0))
+			       == INDIRECT_REF))
+		    {
+		      /* A single indirectref is handled by the middle end.  */
+		      gcc_assert (!POINTER_TYPE_P (TREE_TYPE (decl)));
+		      decl = TREE_OPERAND (decl, 0);
+		      decl = gfc_build_cond_assign_expr (block, present, decl,
+							 null_pointer_node);
+		      OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (decl);
+		    }
 		  else
 		    OMP_CLAUSE_DECL (node) = decl;
 		}
diff --git a/gcc/omp-low.c b/gcc/omp-low.c
index b0168d7..ad26f79 100644
--- a/gcc/omp-low.c
+++ b/gcc/omp-low.c
@@ -11817,7 +11817,8 @@ lower_omp_target (gimple_stmt_iterator *gsi_p, omp_context *ctx)
 	      {
 		gcc_checking_assert (is_gimple_omp_oacc (ctx->stmt));
 		s = TREE_TYPE (ovar);
-		if (TREE_CODE (s) == REFERENCE_TYPE)
+		if (TREE_CODE (s) == REFERENCE_TYPE
+		    || omp_check_optional_argument (ovar, false))
 		  s = TREE_TYPE (s);
 		s = TYPE_SIZE_UNIT (s);
 	      }