gimplify.c (gimplify_scan_omp_clauses) <case OMP_CLAUSE_MAP, [...]): Make sure OMP_CLAUSE_SIZE is non-NULL.

	* gimplify.c (gimplify_scan_omp_clauses) <case OMP_CLAUSE_MAP,
	OMP_CLAUSE_TO, OMP_CLAUSE_FROM): Make sure OMP_CLAUSE_SIZE is
	non-NULL.
	<case OMP_CLAUSE_ALIGNED>: Gimplify OMP_CLAUSE_ALIGNED_ALIGNMENT.
	(gimplify_adjust_omp_clauses_1): Make sure OMP_CLAUSE_SIZE is
	non-NULL.
	(gimplify_adjust_omp_clauses): Likewise.
	* omp-low.c (lower_rec_simd_input_clauses,
	lower_rec_input_clauses, expand_omp_simd): Handle non-constant
	safelen the same as safelen(1).
	* tree-nested.c (convert_nonlocal_omp_clauses,
	convert_local_omp_clauses): Handle OMP_CLAUSE_ALIGNED.  For
	OMP_CLAUSE_{MAP,TO,FROM} if not decl use walk_tree.
	(convert_nonlocal_reference_stmt, convert_local_reference_stmt):
	Fixup handling of GIMPLE_OMP_TARGET.
	(convert_tramp_reference_stmt, convert_gimple_call): Handle
	GIMPLE_OMP_TARGET.
gcc/fortran/
	* dump-parse-tree.c (show_omp_namelist): Use n->udr->udr instead
	of n->udr.
	* f95-lang.c (gfc_init_builtin_functions): Initialize
	BUILT_IN_ASSUME_ALIGNED.
	* gfortran.h (gfc_omp_namelist): Change udr field type to
	struct gfc_omp_namelist_udr.
	(gfc_omp_namelist_udr): New type.
	(gfc_get_omp_namelist_udr): Define.
	(gfc_resolve_code): New prototype.
	* match.c (gfc_free_omp_namelist): Free name->udr.
	* module.c (intrinsics): Add INTRINSIC_USER.
	(fix_mio_expr): Likewise.
	(mio_expr): Handle INSTRINSIC_USER and non-resolved EXPR_FUNCTION.
	* openmp.c (gfc_match_omp_clauses): Adjust initialization of n->udr.
	(gfc_match_omp_declare_reduction): Treat len=: the same as len=*.
	Set attr.flavor on omp_{out,in,priv,orig} artificial variables.
	(struct resolve_omp_udr_callback_data): New type.
	(resolve_omp_udr_callback, resolve_omp_udr_callback2,
	resolve_omp_udr_clause): New functions.
	(resolve_omp_clauses): Adjust for n->udr changes, resolve UDR clauses
	here.
	(omp_udr_callback): Don't check for implicitly declared functions
	here.
	(gfc_resolve_omp_udr): Don't call gfc_resolve.  Don't check for
	implicitly declared subroutines here.
	* resolve.c (resolve_function): If value.function.isym is non-NULL,
	consider it already resolved.
	(resolve_code): Renamed to ...
	(gfc_resolve_code): ... this.  No longer static.
	(gfc_resolve_blocks, generate_component_assignments, resolve_codes):
	Adjust callers.
	* trans-openmp.c (gfc_omp_privatize_by_reference): Don't privatize
	by reference type (C_PTR) variables.
	(gfc_omp_finish_clause): Make sure OMP_CLAUSE_SIZE is non-NULL.
	(gfc_trans_omp_udr_expr): Remove.
	(gfc_trans_omp_array_reduction_or_udr): Adjust for n->udr changes.
	Don't call gfc_trans_omp_udr_expr, even for sym->attr.dimension
	expand it as assignment or subroutine call.  Don't initialize
	value.function.isym.
gcc/testsuite/
	* gfortran.dg/gomp/udr2.f90 (f7, f9): Add !$omp parallel with
	reduction clause.
	* gfortran.dg/gomp/udr4.f90 (f4): Likewise.
	Remove Label is never defined expected error.
	* gfortran.dg/gomp/udr8.f90: New test.
libgomp/
	* testsuite/libgomp.fortran/aligned1.f03: New test.
	* testsuite/libgomp.fortran/nestedfn5.f90: New test.
	* testsuite/libgomp.fortran/target7.f90: Surround loop spawning
	tasks with !$omp parallel !$omp single.
	* testsuite/libgomp.fortran/target8.f90: New test.
	* testsuite/libgomp.fortran/udr4.f90 (foo UDR, bar UDR): Adjust
	not to use trim in the combiner, instead call elemental function.
	(fn): New elemental function.
	* testsuite/libgomp.fortran/udr6.f90 (do_add, dp_add, dp_init):
	Make elemental.
	* testsuite/libgomp.fortran/udr7.f90 (omp_priv, omp_orig, omp_out,
	omp_in): Likewise.
	* testsuite/libgomp.fortran/udr12.f90: New test.
	* testsuite/libgomp.fortran/udr13.f90: New test.
	* testsuite/libgomp.fortran/udr14.f90: New test.
	* testsuite/libgomp.fortran/udr15.f90: New test.

From-SVN: r211929

1 files changed, 46 insertions, 137 deletions

diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 7667f25..458cfff 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -53,11 +53,13 @@ gfc_omp_privatize_by_reference (const_tree decl)
   if (TREE_CODE (type) == POINTER_TYPE)
     {
       /* Array POINTER/ALLOCATABLE have aggregate types, all user variables
-	 that have POINTER_TYPE type and don't have GFC_POINTER_TYPE_P
-	 set are supposed to be privatized by reference.  */
+	 that have POINTER_TYPE type and aren't scalar pointers, scalar
+	 allocatables, Cray pointees or C pointers are supposed to be
+	 privatized by reference.  */
       if (GFC_DECL_GET_SCALAR_POINTER (decl)
 	  || GFC_DECL_GET_SCALAR_ALLOCATABLE (decl)
-	  || GFC_DECL_CRAY_POINTEE (decl))
+	  || GFC_DECL_CRAY_POINTEE (decl)
+	  || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl))))
 	return false;
 
       if (!DECL_ARTIFICIAL (decl)
@@ -895,6 +897,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
       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 (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
     {
@@ -956,6 +959,10 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p)
       gimplify_and_add (stmt, pre_p);
     }
   tree last = c;
+  if (OMP_CLAUSE_SIZE (c) == NULL_TREE)
+    OMP_CLAUSE_SIZE (c)
+      = DECL_P (decl) ? DECL_SIZE_UNIT (decl)
+		      : TYPE_SIZE_UNIT (TREE_TYPE (decl));
   if (c2)
     {
       OMP_CLAUSE_CHAIN (c2) = OMP_CLAUSE_CHAIN (last);
@@ -1182,78 +1189,6 @@ omp_udr_find_orig (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
   return 0;
 }
 
-static tree
-gfc_trans_omp_udr_expr (gfc_omp_namelist *n, bool is_initializer,
-			gfc_expr *syme, gfc_expr *outere)
-{
-  gfc_se symse, outerse;
-  gfc_ss *symss, *outerss;
-  gfc_loopinfo loop;
-  stmtblock_t block, body;
-  tree tem;
-  int i;
-  gfc_namespace *ns = (is_initializer
-		       ? n->udr->initializer_ns : n->udr->combiner_ns);
-
-  syme = gfc_copy_expr (syme);
-  outere = gfc_copy_expr (outere);
-  gfc_init_se (&symse, NULL);
-  gfc_init_se (&outerse, NULL);
-  gfc_start_block (&block);
-  gfc_init_loopinfo (&loop);
-  symss = gfc_walk_expr (syme);
-  outerss = gfc_walk_expr (outere);
-  gfc_add_ss_to_loop (&loop, symss);
-  gfc_add_ss_to_loop (&loop, outerss);
-  gfc_conv_ss_startstride (&loop);
-  /* Enable loop reversal.  */
-  for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
-    loop.reverse[i] = GFC_ENABLE_REVERSE;
-  gfc_conv_loop_setup (&loop, &ns->code->loc);
-  gfc_copy_loopinfo_to_se (&symse, &loop);
-  gfc_copy_loopinfo_to_se (&outerse, &loop);
-  symse.ss = symss;
-  outerse.ss = outerss;
-  gfc_mark_ss_chain_used (symss, 1);
-  gfc_mark_ss_chain_used (outerss, 1);
-  gfc_start_scalarized_body (&loop, &body);
-  gfc_conv_expr (&symse, syme);
-  gfc_conv_expr (&outerse, outere);
-
-  if (is_initializer)
-    {
-      n->udr->omp_priv->backend_decl = symse.expr;
-      n->udr->omp_orig->backend_decl = outerse.expr;
-    }
-  else
-    {
-      n->udr->omp_out->backend_decl = outerse.expr;
-      n->udr->omp_in->backend_decl = symse.expr;
-    }
-
-  if (ns->code->op == EXEC_ASSIGN)
-    tem = gfc_trans_assignment (ns->code->expr1, ns->code->expr2,
-				false, false);
-  else
-    tem = gfc_trans_call (ns->code, false, NULL_TREE, NULL_TREE, false);
-  gfc_add_expr_to_block (&body, tem);
-
-  gcc_assert (symse.ss == gfc_ss_terminator
-	      && outerse.ss == gfc_ss_terminator);
-  /* Generate the copying loops.  */
-  gfc_trans_scalarizing_loops (&loop, &body);
-
-  /* Wrap the whole thing up.  */
-  gfc_add_block_to_block (&block, &loop.pre);
-  gfc_add_block_to_block (&block, &loop.post);
-
-  gfc_cleanup_loop (&loop);
-  gfc_free_expr (syme);
-  gfc_free_expr (outere);
-
-  return gfc_finish_block (&block);
-}
-
 static void
 gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
 {
@@ -1268,6 +1203,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   locus old_loc = gfc_current_locus;
   const char *iname;
   bool t;
+  gfc_omp_udr *udr = n->udr ? n->udr->udr : NULL;
 
   decl = OMP_CLAUSE_DECL (c);
   gfc_current_locus = where;
@@ -1292,7 +1228,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   init_val_sym.attr.flavor = FL_VARIABLE;
   if (OMP_CLAUSE_REDUCTION_CODE (c) != ERROR_MARK)
     backend_decl = omp_reduction_init (c, gfc_sym_type (&init_val_sym));
-  else if (n->udr->initializer_ns)
+  else if (udr->initializer_ns)
     backend_decl = NULL;
   else
     switch (sym->ts.type)
@@ -1334,34 +1270,18 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   gcc_assert (symtree3 == root3);
 
   memset (omp_var_copy, 0, sizeof omp_var_copy);
-  if (n->udr)
+  if (udr)
     {
-      omp_var_copy[0] = *n->udr->omp_out;
-      omp_var_copy[1] = *n->udr->omp_in;
-      if (sym->attr.dimension)
-	{
-	  n->udr->omp_out->ts = sym->ts;
-	  n->udr->omp_in->ts = sym->ts;
-	}
-      else
+      omp_var_copy[0] = *udr->omp_out;
+      omp_var_copy[1] = *udr->omp_in;
+      *udr->omp_out = outer_sym;
+      *udr->omp_in = *sym;
+      if (udr->initializer_ns)
 	{
-	  *n->udr->omp_out = outer_sym;
-	  *n->udr->omp_in = *sym;
-	}
-      if (n->udr->initializer_ns)
-	{
-	  omp_var_copy[2] = *n->udr->omp_priv;
-	  omp_var_copy[3] = *n->udr->omp_orig;
-	  if (sym->attr.dimension)
-	    {
-	      n->udr->omp_priv->ts = sym->ts;
-	      n->udr->omp_orig->ts = sym->ts;
-	    }
-	  else
-	    {
-	      *n->udr->omp_priv = *sym;
-	      *n->udr->omp_orig = outer_sym;
-	    }
+	  omp_var_copy[2] = *udr->omp_priv;
+	  omp_var_copy[3] = *udr->omp_orig;
+	  *udr->omp_priv = *sym;
+	  *udr->omp_orig = outer_sym;
 	}
     }
 
@@ -1394,7 +1314,7 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
       t = gfc_resolve_expr (e2);
       gcc_assert (t);
     }
-  else if (n->udr->initializer_ns == NULL)
+  else if (udr->initializer_ns == NULL)
     {
       gcc_assert (sym->ts.type == BT_DERIVED);
       e2 = gfc_default_initializer (&sym->ts);
@@ -1402,21 +1322,18 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
       t = gfc_resolve_expr (e2);
       gcc_assert (t);
     }
-  else if (n->udr->initializer_ns->code->op == EXEC_ASSIGN)
+  else if (n->udr->initializer->op == EXEC_ASSIGN)
     {
-      if (!sym->attr.dimension)
-	{
-	  e2 = gfc_copy_expr (n->udr->initializer_ns->code->expr2);
-	  t = gfc_resolve_expr (e2);
-	  gcc_assert (t);
-	}
+      e2 = gfc_copy_expr (n->udr->initializer->expr2);
+      t = gfc_resolve_expr (e2);
+      gcc_assert (t);
     }
-  if (n->udr && n->udr->initializer_ns)
+  if (udr && udr->initializer_ns)
     {
       struct omp_udr_find_orig_data cd;
-      cd.omp_udr = n->udr;
+      cd.omp_udr = udr;
       cd.omp_orig_seen = false;
-      gfc_code_walker (&n->udr->initializer_ns->code,
+      gfc_code_walker (&n->udr->initializer,
 		       gfc_dummy_code_callback, omp_udr_find_orig, &cd);
       if (cd.omp_orig_seen)
 	OMP_CLAUSE_REDUCTION_OMP_ORIG_REF (c) = 1;
@@ -1466,18 +1383,15 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
       iname = "ieor";
       break;
     case ERROR_MARK:
-      if (n->udr->combiner_ns->code->op == EXEC_ASSIGN)
+      if (n->udr->combiner->op == EXEC_ASSIGN)
 	{
-	  if (!sym->attr.dimension)
-	    {
-	      gfc_free_expr (e3);
-	      e3 = gfc_copy_expr (n->udr->combiner_ns->code->expr1);
-	      e4 = gfc_copy_expr (n->udr->combiner_ns->code->expr2);
-	      t = gfc_resolve_expr (e3);
-	      gcc_assert (t);
-	      t = gfc_resolve_expr (e4);
-	      gcc_assert (t);
-	    }
+	  gfc_free_expr (e3);
+	  e3 = gfc_copy_expr (n->udr->combiner->expr1);
+	  e4 = gfc_copy_expr (n->udr->combiner->expr2);
+	  t = gfc_resolve_expr (e3);
+	  gcc_assert (t);
+	  t = gfc_resolve_expr (e4);
+	  gcc_assert (t);
 	}
       break;
     default:
@@ -1503,7 +1417,6 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
       e4->expr_type = EXPR_FUNCTION;
       e4->where = where;
       e4->symtree = symtree4;
-      e4->value.function.isym = gfc_find_function (iname);
       e4->value.function.actual = gfc_get_actual_arglist ();
       e4->value.function.actual->expr = e3;
       e4->value.function.actual->next = gfc_get_actual_arglist ();
@@ -1522,10 +1435,8 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   pushlevel ();
   if (e2)
     stmt = gfc_trans_assignment (e1, e2, false, false);
-  else if (sym->attr.dimension)
-    stmt = gfc_trans_omp_udr_expr (n, true, e1, e3);
   else
-    stmt = gfc_trans_call (n->udr->initializer_ns->code, false,
+    stmt = gfc_trans_call (n->udr->initializer, false,
 			   NULL_TREE, NULL_TREE, false);
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -1537,10 +1448,8 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   pushlevel ();
   if (e4)
     stmt = gfc_trans_assignment (e3, e4, false, true);
-  else if (sym->attr.dimension)
-    stmt = gfc_trans_omp_udr_expr (n, false, e1, e3);
   else
-    stmt = gfc_trans_call (n->udr->combiner_ns->code, false,
+    stmt = gfc_trans_call (n->udr->combiner, false,
 			   NULL_TREE, NULL_TREE, false);
   if (TREE_CODE (stmt) != BIND_EXPR)
     stmt = build3_v (BIND_EXPR, NULL, stmt, poplevel (1, 0));
@@ -1566,14 +1475,14 @@ gfc_trans_omp_array_reduction_or_udr (tree c, gfc_omp_namelist *n, locus where)
   if (outer_sym.as)
     gfc_free_array_spec (outer_sym.as);
 
-  if (n->udr)
+  if (udr)
     {
-      *n->udr->omp_out = omp_var_copy[0];
-      *n->udr->omp_in = omp_var_copy[1];
-      if (n->udr->initializer_ns)
+      *udr->omp_out = omp_var_copy[0];
+      *udr->omp_in = omp_var_copy[1];
+      if (udr->initializer_ns)
 	{
-	  *n->udr->omp_priv = omp_var_copy[2];
-	  *n->udr->omp_orig = omp_var_copy[3];
+	  *udr->omp_priv = omp_var_copy[2];
+	  *udr->omp_orig = omp_var_copy[3];
 	}
     }
 }