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

9 files changed, 303 insertions, 194 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 05df7c1..57c5f8f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,45 @@
+2014-06-24  Jakub Jelinek  <jakub@redhat.com>
+
+	* 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.
+
 2014-06-23  Tobias Burnus  <burnus@net-b.de>
 
 	* trans-decl.c (gfc_trans_deferred_vars): Fix handling of
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index de942f8..19f83a9 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1040,7 +1040,7 @@ show_omp_namelist (int list_type, gfc_omp_namelist *n)
 	  case OMP_REDUCTION_IEOR: fputs ("ieor:", dumpfile); break;
 	  case OMP_REDUCTION_USER:
 	    if (n->udr)
-	      fprintf (dumpfile, "%s:", n->udr->name);
+	      fprintf (dumpfile, "%s:", n->udr->udr->name);
 	    break;
 	  default: break;
 	  }
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index e41f61a..40f7f18 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -1082,6 +1082,13 @@ gfc_init_builtin_functions (void)
 		      BUILT_IN_TRAP, NULL, ATTR_NOTHROW_LEAF_LIST);
   TREE_THIS_VOLATILE (builtin_decl_explicit (BUILT_IN_TRAP)) = 1;
 
+  ftype = build_varargs_function_type_list (ptr_type_node, const_ptr_type_node,
+					    size_type_node, NULL_TREE);
+  gfc_define_builtin ("__builtin_assume_aligned", ftype,
+		      BUILT_IN_ASSUME_ALIGNED,
+		      "__builtin_assume_aligned",
+		      ATTR_CONST_NOTHROW_LEAF_LIST);
+
   gfc_define_builtin ("__emutls_get_address",
 		      builtin_types[BT_FN_PTR_PTR],
 		      BUILT_IN_EMUTLS_GET_ADDRESS,
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index a11ca3d..1c4638f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1111,7 +1111,7 @@ typedef struct gfc_omp_namelist
       gfc_omp_depend_op depend_op;
       gfc_omp_map_op map_op;
     } u;
-  struct gfc_omp_udr *udr;
+  struct gfc_omp_namelist_udr *udr;
   struct gfc_omp_namelist *next;
 }
 gfc_omp_namelist;
@@ -1237,6 +1237,15 @@ typedef struct gfc_omp_udr
 gfc_omp_udr;
 #define gfc_get_omp_udr() XCNEW (gfc_omp_udr)
 
+typedef struct gfc_omp_namelist_udr
+{
+  struct gfc_omp_udr *udr;
+  struct gfc_code *combiner;
+  struct gfc_code *initializer;
+}
+gfc_omp_namelist_udr;
+#define gfc_get_omp_namelist_udr() XCNEW (gfc_omp_namelist_udr)
+
 /* The gfc_st_label structure is a BBT attached to a namespace that
    records the usage of statement labels within that space.  */
 
@@ -3011,6 +3020,7 @@ void gfc_free_association_list (gfc_association_list *);
 /* resolve.c */
 bool gfc_resolve_expr (gfc_expr *);
 void gfc_resolve (gfc_namespace *);
+void gfc_resolve_code (gfc_code *, gfc_namespace *);
 void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
 int gfc_impure_variable (gfc_symbol *);
 int gfc_pure (gfc_symbol *);
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 41915b4..b3f47a8 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -4577,6 +4577,14 @@ gfc_free_omp_namelist (gfc_omp_namelist *name)
   for (; name; name = n)
     {
       gfc_free_expr (name->expr);
+      if (name->udr)
+	{
+	  if (name->udr->combiner)
+	    gfc_free_statement (name->udr->combiner);
+	  if (name->udr->initializer)
+	    gfc_free_statement (name->udr->initializer);
+	  free (name->udr);
+	}
       n = name->next;
       free (name);
     }
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index bdd9961..ec67960 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -3136,6 +3136,7 @@ static const mstring intrinsics[] =
     minit ("LE", INTRINSIC_LE_OS),
     minit ("NOT", INTRINSIC_NOT),
     minit ("PARENTHESES", INTRINSIC_PARENTHESES),
+    minit ("USER", INTRINSIC_USER),
     minit (NULL, -1)
 };
 
@@ -3172,7 +3173,8 @@ fix_mio_expr (gfc_expr *e)
 	  && !e->symtree->n.sym->attr.dummy)
 	e->symtree = ns_st;
     }
-  else if (e->expr_type == EXPR_FUNCTION && e->value.function.name)
+  else if (e->expr_type == EXPR_FUNCTION
+	   && (e->value.function.name || e->value.function.isym))
     {
       gfc_symbol *sym;
 
@@ -3287,6 +3289,32 @@ mio_expr (gfc_expr **ep)
 	  mio_expr (&e->value.op.op2);
 	  break;
 
+	case INTRINSIC_USER:
+	  /* INTRINSIC_USER should not appear in resolved expressions,
+	     though for UDRs we need to stream unresolved ones.  */
+	  if (iomode == IO_OUTPUT)
+	    write_atom (ATOM_STRING, e->value.op.uop->name);
+	  else
+	    {
+	      char *name = read_string ();
+	      const char *uop_name = find_use_name (name, true);
+	      if (uop_name == NULL)
+		{
+		  size_t len = strlen (name);
+		  char *name2 = XCNEWVEC (char, len + 2);
+		  memcpy (name2, name, len);
+		  name2[len] = ' ';
+		  name2[len + 1] = '\0';
+		  free (name);
+		  uop_name = name = name2;
+		}
+	      e->value.op.uop = gfc_get_uop (uop_name);
+	      free (name);
+	    }
+	  mio_expr (&e->value.op.op1);
+	  mio_expr (&e->value.op.op2);
+	  break;
+
 	default:
 	  bad_module ("Bad operator");
 	}
@@ -3305,6 +3333,8 @@ mio_expr (gfc_expr **ep)
 	    flag = 1;
 	  else if (e->ref)
 	    flag = 2;
+	  else if (e->value.function.isym == NULL)
+	    flag = 3;
 	  else
 	    flag = 0;
 	  mio_integer (&flag);
@@ -3316,6 +3346,8 @@ mio_expr (gfc_expr **ep)
 	    case 2:
 	      mio_ref_list (&e->ref);
 	      break;
+	    case 3:
+	      break;
 	    default:
 	      write_atom (ATOM_STRING, e->value.function.isym->name);
 	    }
@@ -3323,7 +3355,10 @@ mio_expr (gfc_expr **ep)
       else
 	{
 	  require_atom (ATOM_STRING);
-	  e->value.function.name = gfc_get_string (atom_string);
+	  if (atom_string[0] == '\0')
+	    e->value.function.name = NULL;
+	  else
+	    e->value.function.name = gfc_get_string (atom_string);
 	  free (atom_string);
 
 	  mio_integer (&flag);
@@ -3335,6 +3370,8 @@ mio_expr (gfc_expr **ep)
 	    case 2:
 	      mio_ref_list (&e->ref);
 	      break;
+	    case 3:
+	      break;
 	    default:
 	      require_atom (ATOM_STRING);
 	      e->value.function.isym = gfc_find_function (atom_string);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 266ac3d..68ba70f 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -486,7 +486,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, unsigned int mask,
 		for (n = *head; n; n = n->next)
 		  {
 		    n->u.reduction_op = rop;
-		    n->udr = udr;
+		    if (udr)
+		      {
+			n->udr = gfc_get_omp_namelist_udr ();
+			n->udr->udr = udr;
+		      }
 		  }
 	      continue;
 	    }
@@ -1182,6 +1186,9 @@ gfc_match_omp_declare_reduction (void)
   m = gfc_match_type_spec (&ts);
   if (m != MATCH_YES)
     return MATCH_ERROR;
+  /* Treat len=: the same as len=*.  */
+  if (ts.type == BT_CHARACTER)
+    ts.deferred = false;
   tss.safe_push (ts);
 
   while (gfc_match_char (',') == MATCH_YES)
@@ -1219,6 +1226,8 @@ gfc_match_omp_declare_reduction (void)
       omp_in->n.sym->ts = tss[i];
       omp_out->n.sym->attr.omp_udr_artificial_var = 1;
       omp_in->n.sym->attr.omp_udr_artificial_var = 1;
+      omp_out->n.sym->attr.flavor = FL_VARIABLE;
+      omp_in->n.sym->attr.flavor = FL_VARIABLE;
       gfc_commit_symbols ();
       omp_udr->combiner_ns = combiner_ns;
       omp_udr->omp_out = omp_out->n.sym;
@@ -1249,6 +1258,8 @@ gfc_match_omp_declare_reduction (void)
 	  omp_orig->n.sym->ts = tss[i];
 	  omp_priv->n.sym->attr.omp_udr_artificial_var = 1;
 	  omp_orig->n.sym->attr.omp_udr_artificial_var = 1;
+	  omp_priv->n.sym->attr.flavor = FL_VARIABLE;
+	  omp_orig->n.sym->attr.flavor = FL_VARIABLE;
 	  gfc_commit_symbols ();
 	  omp_udr->initializer_ns = initializer_ns;
 	  omp_udr->omp_priv = omp_priv->n.sym;
@@ -1900,6 +1911,104 @@ gfc_match_omp_end_single (void)
 }
 
 
+struct resolve_omp_udr_callback_data
+{
+  gfc_symbol *sym1, *sym2;
+};
+
+
+static int
+resolve_omp_udr_callback (gfc_expr **e, int *, void *data)
+{
+  struct resolve_omp_udr_callback_data *rcd
+    = (struct resolve_omp_udr_callback_data *) data;
+  if ((*e)->expr_type == EXPR_VARIABLE
+      && ((*e)->symtree->n.sym == rcd->sym1
+	  || (*e)->symtree->n.sym == rcd->sym2))
+    {
+      gfc_ref *ref = gfc_get_ref ();
+      ref->type = REF_ARRAY;
+      ref->u.ar.where = (*e)->where;
+      ref->u.ar.as = (*e)->symtree->n.sym->as;
+      ref->u.ar.type = AR_FULL;
+      ref->u.ar.dimen = 0;
+      ref->next = (*e)->ref;
+      (*e)->ref = ref;
+    }
+  return 0;
+}
+
+
+static int
+resolve_omp_udr_callback2 (gfc_expr **e, int *, void *)
+{
+  if ((*e)->expr_type == EXPR_FUNCTION
+      && (*e)->value.function.isym == NULL)
+    {
+      gfc_symbol *sym = (*e)->symtree->n.sym;
+      if (!sym->attr.intrinsic
+	  && sym->attr.if_source == IFSRC_UNKNOWN)
+	gfc_error ("Implicitly declared function %s used in "
+		   "!$OMP DECLARE REDUCTION at %L ", sym->name, &(*e)->where);
+    }
+  return 0;
+}
+
+
+static gfc_code *
+resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
+			gfc_symbol *sym1, gfc_symbol *sym2)
+{
+  gfc_code *copy;
+  gfc_symbol sym1_copy, sym2_copy;
+
+  if (ns->code->op == EXEC_ASSIGN)
+    {
+      copy = gfc_get_code (EXEC_ASSIGN);
+      copy->expr1 = gfc_copy_expr (ns->code->expr1);
+      copy->expr2 = gfc_copy_expr (ns->code->expr2);
+    }
+  else
+    {
+      copy = gfc_get_code (EXEC_CALL);
+      copy->symtree = ns->code->symtree;
+      copy->ext.actual = gfc_copy_actual_arglist (ns->code->ext.actual);
+    }
+  copy->loc = ns->code->loc;
+  sym1_copy = *sym1;
+  sym2_copy = *sym2;
+  *sym1 = *n->sym;
+  *sym2 = *n->sym;
+  sym1->name = sym1_copy.name;
+  sym2->name = sym2_copy.name;
+  ns->proc_name = ns->parent->proc_name;
+  if (n->sym->attr.dimension)
+    {
+      struct resolve_omp_udr_callback_data rcd;
+      rcd.sym1 = sym1;
+      rcd.sym2 = sym2;
+      gfc_code_walker (&copy, gfc_dummy_code_callback,
+		       resolve_omp_udr_callback, &rcd);
+    }
+  gfc_resolve_code (copy, gfc_current_ns);
+  if (copy->op == EXEC_CALL && copy->resolved_isym == NULL)
+    {
+      gfc_symbol *sym = copy->resolved_sym;
+      if (sym
+	  && !sym->attr.intrinsic
+	  && sym->attr.if_source == IFSRC_UNKNOWN)
+	gfc_error ("Implicitly declared subroutine %s used in "
+		   "!$OMP DECLARE REDUCTION at %L ", sym->name,
+		   &copy->loc);
+    }
+  gfc_code_walker (&copy, gfc_dummy_code_callback,
+		   resolve_omp_udr_callback2, NULL);
+  *sym1 = sym1_copy;
+  *sym2 = sym2_copy;
+  return copy;
+}
+
+
 /* OpenMP directive resolving routines.  */
 
 static void
@@ -2295,9 +2404,15 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 			const char *udr_name = NULL;
 			if (n->udr)
 			  {
-			    udr_name = n->udr->name;
-			    n->udr = gfc_find_omp_udr (NULL, udr_name,
-						       &n->sym->ts);
+			    udr_name = n->udr->udr->name;
+			    n->udr->udr
+			      = gfc_find_omp_udr (NULL, udr_name,
+						  &n->sym->ts);
+			    if (n->udr->udr == NULL)
+			      {
+				free (n->udr);
+				n->udr = NULL;
+			      }
 			  }
 			if (n->udr == NULL)
 			  {
@@ -2337,7 +2452,20 @@ resolve_omp_clauses (gfc_code *code, locus *where,
 				       gfc_typename (&n->sym->ts), where);
 			  }
 			else
-			  n->u.reduction_op = OMP_REDUCTION_USER;
+			  {
+			    gfc_omp_udr *udr = n->udr->udr;
+			    n->u.reduction_op = OMP_REDUCTION_USER;
+			    n->udr->combiner
+			      = resolve_omp_udr_clause (n, udr->combiner_ns,
+							udr->omp_out,
+							udr->omp_in);
+			    if (udr->initializer_ns)
+			      n->udr->initializer
+				= resolve_omp_udr_clause (n,
+							  udr->initializer_ns,
+							  udr->omp_priv,
+							  udr->omp_orig);
+			  }
 		      }
 		    break;
 		  case OMP_LIST_LINEAR:
@@ -3317,15 +3445,6 @@ omp_udr_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
 		       &(*e)->where);
 	}
     }
-  else if ((*e)->expr_type == EXPR_FUNCTION
-	   && (*e)->value.function.isym == NULL)
-    {
-      gfc_symbol *sym = (*e)->symtree->n.sym;
-      if (!sym->attr.intrinsic
-	  && sym->attr.if_source == IFSRC_UNKNOWN)
-	gfc_error ("Implicitly declared function %s used in "
-		   "!$OMP DECLARE REDUCTION at %L ", sym->name, &(*e)->where);
-    }
   return 0;
 }
 
@@ -3337,9 +3456,6 @@ gfc_resolve_omp_udr (gfc_omp_udr *omp_udr)
   gfc_actual_arglist *a;
   const char *predef_name = NULL;
 
-  gfc_resolve (omp_udr->combiner_ns);
-  if (omp_udr->initializer_ns)
-    gfc_resolve (omp_udr->initializer_ns);
   switch (omp_udr->rop)
     {
     case OMP_REDUCTION_PLUS:
@@ -3394,16 +3510,6 @@ gfc_resolve_omp_udr (gfc_omp_udr *omp_udr)
 	gfc_error ("Subroutine call with alternate returns in combiner "
 		   "of !$OMP DECLARE REDUCTION at %L",
 		   &omp_udr->combiner_ns->code->loc);
-      if (omp_udr->combiner_ns->code->resolved_isym == NULL)
-	{
-	  gfc_symbol *sym = omp_udr->combiner_ns->code->resolved_sym;
-	  if (sym
-	      && !sym->attr.intrinsic
-	      && sym->attr.if_source == IFSRC_UNKNOWN)
-	    gfc_error ("Implicitly declared subroutine %s used in "
-		       "!$OMP DECLARE REDUCTION at %L ", sym->name,
-		       &omp_udr->combiner_ns->code->loc);
-	}
     }
   if (omp_udr->initializer_ns)
     {
@@ -3429,16 +3535,6 @@ gfc_resolve_omp_udr (gfc_omp_udr *omp_udr)
 	    gfc_error ("One of actual subroutine arguments in INITIALIZER "
 		       "clause of !$OMP DECLARE REDUCTION must be OMP_PRIV "
 		       "at %L", &omp_udr->initializer_ns->code->loc);
-	  if (omp_udr->initializer_ns->code->resolved_isym == NULL)
-	    {
-	      gfc_symbol *sym = omp_udr->initializer_ns->code->resolved_sym;
-	      if (sym
-		  && !sym->attr.intrinsic
-		  && sym->attr.if_source == IFSRC_UNKNOWN)
-		gfc_error ("Implicitly declared subroutine %s used in "
-			   "!$OMP DECLARE REDUCTION at %L ", sym->name,
-			   &omp_udr->initializer_ns->code->loc);
-	    }
 	}
     }
   else if (omp_udr->ts.type == BT_DERIVED
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 64f3489..48b3a40 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -40,7 +40,7 @@ typedef enum seq_type
 seq_type;
 
 /* Stack to keep track of the nesting of blocks as we move through the
-   code.  See resolve_branch() and resolve_code().  */
+   code.  See resolve_branch() and gfc_resolve_code().  */
 
 typedef struct code_stack
 {
@@ -2887,7 +2887,8 @@ resolve_function (gfc_expr *expr)
 
   /* See if function is already resolved.  */
 
-  if (expr->value.function.name != NULL)
+  if (expr->value.function.name != NULL
+      || expr->value.function.isym != NULL)
     {
       if (expr->ts.type == BT_UNKNOWN)
 	expr->ts = sym->ts;
@@ -4930,7 +4931,7 @@ resolve_variable (gfc_expr *e)
   if (check_assumed_size_reference (sym, e))
     return false;
 
-  /* Deal with forward references to entries during resolve_code, to
+  /* Deal with forward references to entries during gfc_resolve_code, to
      satisfy, at least partially, 12.5.2.5.  */
   if (gfc_current_ns->entries
       && current_entry_id == sym->entry_id
@@ -8979,8 +8980,6 @@ resolve_block_construct (gfc_code* code)
 /* Resolve lists of blocks found in IF, SELECT CASE, WHERE, FORALL, GOTO and
    DO code nodes.  */
 
-static void resolve_code (gfc_code *, gfc_namespace *);
-
 void
 gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 {
@@ -9072,7 +9071,7 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
 	  gfc_internal_error ("gfc_resolve_blocks(): Bad block type");
 	}
 
-      resolve_code (b->next, ns);
+      gfc_resolve_code (b->next, ns);
     }
 }
 
@@ -9520,7 +9519,7 @@ nonscalar_typebound_assign (gfc_symbol *derived, int depth)
    The pointer assignments are taken care of by the intrinsic
    assignment of the structure itself.  This function recursively adds
    defined assignments where required.  The recursion is accomplished
-   by calling resolve_code.
+   by calling gfc_resolve_code.
 
    When the lhs in a defined assignment has intent INOUT, we need a
    temporary for the lhs.  In pseudo-code:
@@ -9638,9 +9637,9 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
 				    comp1, comp2, (*code)->loc);
 
       /* Convert the assignment if there is a defined assignment for
-	 this type.  Otherwise, using the call from resolve_code,
+	 this type.  Otherwise, using the call from gfc_resolve_code,
 	 recurse into its components.  */
-      resolve_code (this_code, ns);
+      gfc_resolve_code (this_code, ns);
 
       if (this_code->op == EXEC_ASSIGN_CALL)
 	{
@@ -9804,8 +9803,8 @@ generate_component_assignments (gfc_code **code, gfc_namespace *ns)
 /* Given a block of code, recursively resolve everything pointed to by this
    code block.  */
 
-static void
-resolve_code (gfc_code *code, gfc_namespace *ns)
+void
+gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
 {
   int omp_workshare_save;
   int forall_save, do_concurrent_save;
@@ -10091,7 +10090,8 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
 
 	case EXEC_DO_WHILE:
 	  if (code->expr1 == NULL)
-	    gfc_internal_error ("resolve_code(): No expression on DO WHILE");
+	    gfc_internal_error ("gfc_resolve_code(): No expression on "
+				"DO WHILE");
 	  if (t
 	      && (code->expr1->rank != 0
 		  || code->expr1->ts.type != BT_LOGICAL))
@@ -10233,7 +10233,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
 	  break;
 
 	default:
-	  gfc_internal_error ("resolve_code(): Bad statement code");
+	  gfc_internal_error ("gfc_resolve_code(): Bad statement code");
 	}
     }
 
@@ -14696,7 +14696,7 @@ gfc_resolve_uops (gfc_symtree *symtree)
    assign types to all intermediate expressions, make sure that all
    assignments are to compatible types and figure out which names
    refer to which functions or subroutines.  It doesn't check code
-   block, which is handled by resolve_code.  */
+   block, which is handled by gfc_resolve_code.  */
 
 static void
 resolve_types (gfc_namespace *ns)
@@ -14785,7 +14785,7 @@ resolve_types (gfc_namespace *ns)
 }
 
 
-/* Call resolve_code recursively.  */
+/* Call gfc_resolve_code recursively.  */
 
 static void
 resolve_codes (gfc_namespace *ns)
@@ -14811,7 +14811,7 @@ resolve_codes (gfc_namespace *ns)
   old_obstack = labels_obstack;
   bitmap_obstack_initialize (&labels_obstack);
 
-  resolve_code (ns->code, ns);
+  gfc_resolve_code (ns->code, ns);
 
   bitmap_obstack_release (&labels_obstack);
   labels_obstack = old_obstack;
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];
 	}
     }
 }