--- a/gcc/fortran/expr.c	Fri Oct 27 22:46:09 2017 +0900
+++ b/gcc/fortran/expr.c	Thu Oct 25 07:37:49 2018 +0900
@@ -1,5 +1,5 @@
 /* Routines for manipulation of expression nodes.
-   Copyright (C) 2000-2017 Free Software Foundation, Inc.
+   Copyright (C) 2000-2018 Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -27,6 +27,7 @@
 #include "match.h"
 #include "target-memory.h" /* for gfc_convert_boz */
 #include "constructor.h"
+#include "tree.h"
 
 
 /* The following set of functions provide access to gfc_expr* of
@@ -184,7 +185,7 @@
    blanked and null-terminated.  */
 
 gfc_expr *
-gfc_get_character_expr (int kind, locus *where, const char *src, int len)
+gfc_get_character_expr (int kind, locus *where, const char *src, gfc_charlen_t len)
 {
   gfc_expr *e;
   gfc_char_t *dest;
@@ -210,13 +211,14 @@
 /* Get a new expression node that is an integer constant.  */
 
 gfc_expr *
-gfc_get_int_expr (int kind, locus *where, int value)
+gfc_get_int_expr (int kind, locus *where, HOST_WIDE_INT value)
 {
   gfc_expr *p;
   p = gfc_get_constant_expr (BT_INTEGER, kind,
 			     where ? where : &gfc_current_locus);
 
-  mpz_set_si (p->value.integer, value);
+  const wide_int w = wi::shwi (value, kind * BITS_PER_UNIT);
+  wi::to_mpz (w, p->value.integer, SIGNED);
 
   return p;
 }
@@ -672,6 +674,62 @@
 }
 
 
+/* Same as gfc_extract_int, but use a HWI.  */
+
+bool
+gfc_extract_hwi (gfc_expr *expr, HOST_WIDE_INT *result, int report_error)
+{
+  gfc_ref *ref;
+
+  /* A KIND component is a parameter too. The expression for it is
+     stored in the initializer and should be consistent with the tests
+     below.  */
+  if (gfc_expr_attr(expr).pdt_kind)
+    {
+      for (ref = expr->ref; ref; ref = ref->next)
+	{
+	  if (ref->u.c.component->attr.pdt_kind)
+	    expr = ref->u.c.component->initializer;
+	}
+    }
+
+  if (expr->expr_type != EXPR_CONSTANT)
+    {
+      if (report_error > 0)
+	gfc_error ("Constant expression required at %C");
+      else if (report_error < 0)
+	gfc_error_now ("Constant expression required at %C");
+      return true;
+    }
+
+  if (expr->ts.type != BT_INTEGER)
+    {
+      if (report_error > 0)
+	gfc_error ("Integer expression required at %C");
+      else if (report_error < 0)
+	gfc_error_now ("Integer expression required at %C");
+      return true;
+    }
+
+  /* Use long_long_integer_type_node to determine when to saturate.  */
+  const wide_int val = wi::from_mpz (long_long_integer_type_node,
+				     expr->value.integer, false);
+
+  if (!wi::fits_shwi_p (val))
+    {
+      if (report_error > 0)
+	gfc_error ("Integer value too large in expression at %C");
+      else if (report_error < 0)
+	gfc_error_now ("Integer value too large in expression at %C");
+      return true;
+    }
+
+  *result = val.to_shwi ();
+
+  return false;
+}
+
+
 /* Recursively copy a list of reference structures.  */
 
 gfc_ref *
@@ -1011,6 +1069,7 @@
 
   if (e->symtree->n.sym->ts.type == BT_CLASS
       && e->symtree->n.sym->attr.dummy
+      && CLASS_DATA (e->symtree->n.sym)->attr.dimension
       && CLASS_DATA (e->symtree->n.sym)->attr.class_pointer)
     return true;
 
@@ -1604,9 +1663,9 @@
 static bool
 find_substring_ref (gfc_expr *p, gfc_expr **newp)
 {
-  int end;
-  int start;
-  int length;
+  gfc_charlen_t end;
+  gfc_charlen_t start;
+  gfc_charlen_t length;
   gfc_char_t *chr;
 
   if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT
@@ -1616,9 +1675,12 @@
   *newp = gfc_copy_expr (p);
   free ((*newp)->value.character.string);
 
-  end = (int) mpz_get_ui (p->ref->u.ss.end->value.integer);
-  start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer);
-  length = end - start + 1;
+  end = (gfc_charlen_t) mpz_get_ui (p->ref->u.ss.end->value.integer);
+  start = (gfc_charlen_t) mpz_get_ui (p->ref->u.ss.start->value.integer);
+  if (end >= start)
+    length = end - start + 1;
+  else
+    length = 0;
 
   chr = (*newp)->value.character.string = gfc_get_wide_string (length + 1);
   (*newp)->value.character.length = length;
@@ -1701,7 +1763,7 @@
 			 a substring out of it, update the type-spec's
 			 character length according to the first element
 			 (as all should have the same length).  */
-		      int string_len;
+		      gfc_charlen_t string_len;
 		      if ((c = gfc_constructor_first (p->value.constructor)))
 			{
 			  const gfc_expr* first = c->expr;
@@ -1719,7 +1781,7 @@
 			gfc_free_expr (p->ts.u.cl->length);
 
 		      p->ts.u.cl->length
-			= gfc_get_int_expr (gfc_default_integer_kind,
+			= gfc_get_int_expr (gfc_charlen_int_kind,
 					    NULL, string_len);
 		    }
 		}
@@ -1799,6 +1861,22 @@
   gfc_expr *e;
   bool t;
 
+  if (gfc_is_size_zero_array (p))
+    {
+      if (p->expr_type == EXPR_ARRAY)
+	return true;
+
+      e = gfc_get_expr ();
+      e->expr_type = EXPR_ARRAY;
+      e->ts = p->ts;
+      e->rank = p->rank;
+      e->value.constructor = NULL;
+      e->shape = gfc_copy_shape (p->shape, p->rank);
+      e->where = p->where;
+      gfc_replace_expr (p, e);
+      return true;
+    }
+
   e = gfc_copy_expr (p->symtree->n.sym->value);
   if (e == NULL)
     return false;
@@ -1819,6 +1897,10 @@
   return t;
 }
 
+
+static bool
+scalarize_intrinsic_call (gfc_expr *, bool init_flag);
+
 /* Given an expression, simplify it by collapsing constant
    expressions.  Most simplification takes place when the expression
    tree is being constructed.  If an intrinsic function is simplified
@@ -1842,6 +1924,8 @@
 gfc_simplify_expr (gfc_expr *p, int type)
 {
   gfc_actual_arglist *ap;
+  gfc_intrinsic_sym* isym = NULL;
+
 
   if (p == NULL)
     return true;
@@ -1853,7 +1937,20 @@
       break;
 
     case EXPR_FUNCTION:
-      for (ap = p->value.function.actual; ap; ap = ap->next)
+      // For array-bound functions, we don't need to optimize
+      // the 'array' argument. In particular, if the argument
+      // is a PARAMETER, simplifying might convert an EXPR_VARIABLE
+      // into an EXPR_ARRAY; the latter has lbound = 1, the former
+      // can have any lbound.
+      ap = p->value.function.actual;
+      if (p->value.function.isym &&
+	  (p->value.function.isym->id == GFC_ISYM_LBOUND
+	   || p->value.function.isym->id == GFC_ISYM_UBOUND
+	   || p->value.function.isym->id == GFC_ISYM_LCOBOUND
+	   || p->value.function.isym->id == GFC_ISYM_UCOBOUND))
+	ap = ap->next;
+
+      for ( ; ap; ap = ap->next)
 	if (!gfc_simplify_expr (ap->expr, type))
 	  return false;
 
@@ -1861,6 +1958,14 @@
 	  && gfc_intrinsic_func_interface (p, 1) == MATCH_ERROR)
 	return false;
 
+      if (p->expr_type == EXPR_FUNCTION)
+	{
+	  if (p->symtree)
+	    isym = gfc_find_function (p->symtree->n.sym->name);
+	  if (isym && isym->elemental)
+	    scalarize_intrinsic_call (p, false);
+	}
+
       break;
 
     case EXPR_SUBSTRING:
@@ -1870,18 +1975,18 @@
       if (gfc_is_constant_expr (p))
 	{
 	  gfc_char_t *s;
-	  int start, end;
+	  HOST_WIDE_INT start, end;
 
 	  start = 0;
 	  if (p->ref && p->ref->u.ss.start)
 	    {
-	      gfc_extract_int (p->ref->u.ss.start, &start);
+	      gfc_extract_hwi (p->ref->u.ss.start, &start);
 	      start--;  /* Convert from one-based to zero-based.  */
 	    }
 
 	  end = p->value.character.length;
 	  if (p->ref && p->ref->u.ss.end)
-	    gfc_extract_int (p->ref->u.ss.end, &end);
+	    gfc_extract_hwi (p->ref->u.ss.end, &end);
 
 	  if (end < start)
 	    end = start;
@@ -1894,7 +1999,7 @@
 	  p->value.character.string = s;
 	  p->value.character.length = end - start;
 	  p->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL);
-	  p->ts.u.cl->length = gfc_get_int_expr (gfc_default_integer_kind,
+	  p->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
 						 NULL,
 						 p->value.character.length);
 	  gfc_free_ref_list (p->ref);
@@ -1974,7 +2079,7 @@
 /* Scalarize an expression for an elemental intrinsic call.  */
 
 static bool
-scalarize_intrinsic_call (gfc_expr *e)
+scalarize_intrinsic_call (gfc_expr *e, bool init_flag)
 {
   gfc_actual_arglist *a, *b;
   gfc_constructor_base ctor;
@@ -1982,6 +2087,15 @@
   gfc_constructor *ci, *new_ctor;
   gfc_expr *expr, *old;
   int n, i, rank[5], array_arg;
+  int errors = 0;
+
+  if (e == NULL)
+    return false;
+
+  a = e->value.function.actual;
+  for (; a; a = a->next)
+    if (a->expr && !gfc_is_constant_expr (a->expr))
+      return false;
 
   /* Find which, if any, arguments are arrays.  Assume that the old
      expression carries the type information and that the first arg
@@ -2016,7 +2130,7 @@
   for (; a; a = a->next)
     {
       /* Check that this is OK for an initialization expression.  */
-      if (a->expr && !gfc_check_init_expr (a->expr))
+      if (a->expr && init_flag && !gfc_check_init_expr (a->expr))
 	goto cleanup;
 
       rank[n] = 0;
@@ -2041,6 +2155,7 @@
       n++;
     }
 
+  gfc_get_errors (NULL, &errors);
 
   /* Using the array argument as the master, step through the array
      calling the function for each element and advancing the array
@@ -2075,7 +2190,8 @@
       /* Simplify the function calls.  If the simplification fails, the
 	 error will be flagged up down-stream or the library will deal
 	 with it.  */
-      gfc_simplify_expr (new_ctor->expr, 0);
+      if (errors == 0)
+	gfc_simplify_expr (new_ctor->expr, 0);
 
       for (i = 0; i < n; i++)
 	if (args[i])
@@ -2345,7 +2461,7 @@
 
 	/* Assumed character length will not reduce to a constant expression
 	   with LEN, as required by the standard.  */
-	if (i == 5 && not_restricted
+	if (i == 5 && not_restricted && ap->expr->symtree
 	    && ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
 	    && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
 		|| ap->expr->symtree->n.sym->ts.deferred))
@@ -2549,7 +2665,7 @@
 	   array argument.  */
 	isym = gfc_find_function (e->symtree->n.sym->name);
 	if (isym && isym->elemental
-	    && (t = scalarize_intrinsic_call (e)))
+	    && (t = scalarize_intrinsic_call (e, true)))
 	  break;
       }
 
@@ -3337,6 +3453,8 @@
   /* Only DATA Statements come here.  */
   if (!conform)
     {
+      locus *where;
+
       /* Numeric can be converted to any other numeric. And Hollerith can be
 	 converted to any other type.  */
       if ((gfc_numeric_ts (&lvalue->ts) && gfc_numeric_ts (&rvalue->ts))
@@ -3346,8 +3464,9 @@
       if (lvalue->ts.type == BT_LOGICAL && rvalue->ts.type == BT_LOGICAL)
 	return true;
 
+      where = lvalue->where.lb ? &lvalue->where : &rvalue->where;
       gfc_error ("Incompatible types in DATA statement at %L; attempted "
-		 "conversion of %s to %s", &lvalue->where,
+		 "conversion of %s to %s", where,
 		 gfc_typename (&rvalue->ts), gfc_typename (&lvalue->ts));
 
       return false;
@@ -3851,13 +3970,13 @@
 	  }
     }
 
-  /* Error for assignments of contiguous pointers to targets which is not
+  /* Warn for assignments of contiguous pointers to targets which is not
      contiguous.  Be lenient in the definition of what counts as
-     congiguous.  */
+     contiguous.  */
 
   if (lhs_attr.contiguous && !gfc_is_simply_contiguous (rvalue, false, true))
-    gfc_error ("Assignment to contiguous pointer from non-contiguous "
-	       "target at %L", &rvalue->where);
+    gfc_warning (OPT_Wextra, "Assignment to contiguous pointer from "
+		 "non-contiguous target at %L", &rvalue->where);
 
   /* Warn if it is the LHS pointer may lives longer than the RHS target.  */
   if (warn_target_lifetime
@@ -4013,28 +4132,46 @@
   return true;
 }
 
-
-/* Build an initializer for a local integer, real, complex, logical, or
-   character variable, based on the command line flags finit-local-zero,
-   finit-integer=, finit-real=, finit-logical=, and finit-character=.  */
+/* Invoke gfc_build_init_expr to create an initializer expression, but do not
+ * require that an expression be built.  */
 
 gfc_expr *
 gfc_build_default_init_expr (gfc_typespec *ts, locus *where)
 {
-  int char_len;
+  return gfc_build_init_expr (ts, where, false);
+}
+
+/* Build an initializer for a local integer, real, complex, logical, or
+   character variable, based on the command line flags finit-local-zero,
+   finit-integer=, finit-real=, finit-logical=, and finit-character=.
+   With force, an initializer is ALWAYS generated.  */
+
+gfc_expr *
+gfc_build_init_expr (gfc_typespec *ts, locus *where, bool force)
+{
   gfc_expr *init_expr;
-  int i;
 
   /* Try to build an initializer expression.  */
   init_expr = gfc_get_constant_expr (ts->type, ts->kind, where);
 
+  /* If we want to force generation, make sure we default to zero.  */
+  gfc_init_local_real init_real = flag_init_real;
+  int init_logical = gfc_option.flag_init_logical;
+  if (force)
+    {
+      if (init_real == GFC_INIT_REAL_OFF)
+	init_real = GFC_INIT_REAL_ZERO;
+      if (init_logical == GFC_INIT_LOGICAL_OFF)
+	init_logical = GFC_INIT_LOGICAL_FALSE;
+    }
+
   /* We will only initialize integers, reals, complex, logicals, and
      characters, and only if the corresponding command-line flags
      were set.  Otherwise, we free init_expr and return null.  */
   switch (ts->type)
     {
     case BT_INTEGER:
-      if (gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF)
+      if (force || gfc_option.flag_init_integer != GFC_INIT_INTEGER_OFF)
         mpz_set_si (init_expr->value.integer,
                          gfc_option.flag_init_integer_value);
       else
@@ -4045,7 +4182,7 @@
       break;
 
     case BT_REAL:
-      switch (flag_init_real)
+      switch (init_real)
         {
         case GFC_INIT_REAL_SNAN:
           init_expr->is_snan = 1;
@@ -4074,7 +4211,7 @@
       break;
 
     case BT_COMPLEX:
-      switch (flag_init_real)
+      switch (init_real)
         {
         case GFC_INIT_REAL_SNAN:
           init_expr->is_snan = 1;
@@ -4106,9 +4243,9 @@
       break;
 
     case BT_LOGICAL:
-      if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_FALSE)
+      if (init_logical == GFC_INIT_LOGICAL_FALSE)
         init_expr->value.logical = 0;
-      else if (gfc_option.flag_init_logical == GFC_INIT_LOGICAL_TRUE)
+      else if (init_logical == GFC_INIT_LOGICAL_TRUE)
         init_expr->value.logical = 1;
       else
         {
@@ -4120,14 +4257,14 @@
     case BT_CHARACTER:
       /* For characters, the length must be constant in order to
          create a default initializer.  */
-      if (gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
+      if ((force || gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON)
           && ts->u.cl->length
           && ts->u.cl->length->expr_type == EXPR_CONSTANT)
         {
-          char_len = mpz_get_si (ts->u.cl->length->value.integer);
+          HOST_WIDE_INT char_len = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
           init_expr->value.character.length = char_len;
           init_expr->value.character.string = gfc_get_wide_string (char_len+1);
-          for (i = 0; i < char_len; i++)
+          for (size_t i = 0; i < (size_t) char_len; i++)
             init_expr->value.character.string[i]
               = (unsigned char) gfc_option.flag_init_character_value;
         }
@@ -4136,7 +4273,8 @@
           gfc_free_expr (init_expr);
           init_expr = NULL;
         }
-      if (!init_expr && gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON
+      if (!init_expr
+	  && (force || gfc_option.flag_init_character == GFC_INIT_CHARACTER_ON)
           && ts->u.cl->length && flag_max_stack_var_size != 0)
         {
           gfc_actual_arglist *arg;
@@ -4176,18 +4314,17 @@
       && ts->u.cl
       && ts->u.cl->length && ts->u.cl->length->expr_type == EXPR_CONSTANT)
     {
-      int len;
-
       gcc_assert (ts->u.cl && ts->u.cl->length);
       gcc_assert (ts->u.cl->length->expr_type == EXPR_CONSTANT);
       gcc_assert (ts->u.cl->length->ts.type == BT_INTEGER);
 
-      len = mpz_get_si (ts->u.cl->length->value.integer);
+      HOST_WIDE_INT len = gfc_mpz_get_hwi (ts->u.cl->length->value.integer);
 
       if (init->expr_type == EXPR_CONSTANT)
         gfc_set_constant_character_len (len, init, -1);
       else if (init
-               && init->ts.u.cl
+	       && init->ts.type == BT_CHARACTER
+               && init->ts.u.cl && init->ts.u.cl->length
                && mpz_cmp (ts->u.cl->length->value.integer,
                            init->ts.u.cl->length->value.integer))
         {
@@ -4196,7 +4333,6 @@
 
           if (ctor)
             {
-              int first_len;
               bool has_ts = (init->ts.u.cl
                              && init->ts.u.cl->length_from_typespec);
 
@@ -4205,7 +4341,7 @@
                  length.  This need not be the length of the LHS!  */
               gcc_assert (ctor->expr->expr_type == EXPR_CONSTANT);
               gcc_assert (ctor->expr->ts.type == BT_CHARACTER);
-              first_len = ctor->expr->value.character.length;
+              gfc_charlen_t first_len = ctor->expr->value.character.length;
 
               for ( ; ctor; ctor = gfc_constructor_next (ctor))
                 if (ctor->expr->expr_type == EXPR_CONSTANT)
@@ -4330,25 +4466,60 @@
   return init;
 }
 
+static bool
+class_allocatable (gfc_component *comp)
+{
+  return comp->ts.type == BT_CLASS && CLASS_DATA (comp)
+    && CLASS_DATA (comp)->attr.allocatable;
+}
+
+static bool
+class_pointer (gfc_component *comp)
+{
+  return comp->ts.type == BT_CLASS && CLASS_DATA (comp)
+    && CLASS_DATA (comp)->attr.pointer;
+}
+
+static bool
+comp_allocatable (gfc_component *comp)
+{
+  return comp->attr.allocatable || class_allocatable (comp);
+}
+
+static bool
+comp_pointer (gfc_component *comp)
+{
+  return comp->attr.pointer
+    || comp->attr.pointer
+    || comp->attr.proc_pointer
+    || comp->attr.class_pointer
+    || class_pointer (comp);
+}
+
 /* Fetch or generate an initializer for the given component.
    Only generate an initializer if generate is true.  */
 
 static gfc_expr *
-component_initializer (gfc_typespec *ts, gfc_component *c, bool generate)
+component_initializer (gfc_component *c, bool generate)
 {
   gfc_expr *init = NULL;
 
-  /* See if we can find the initializer immediately.
-     Some components should never get initializers.  */
-  if (c->initializer || !generate
-      || (ts->type == BT_CLASS && !c->attr.allocatable)
-      || c->attr.pointer
-      || c->attr.class_pointer
-      || c->attr.proc_pointer)
+  /* Allocatable components always get EXPR_NULL.
+     Pointer components are only initialized when generating, and only if they
+     do not already have an initializer.  */
+  if (comp_allocatable (c) || (generate && comp_pointer (c) && !c->initializer))
+    {
+      init = gfc_get_null_expr (&c->loc);
+      init->ts = c->ts;
+      return init;
+    }
+
+  /* See if we can find the initializer immediately.  */
+  if (c->initializer || !generate)
     return c->initializer;
 
   /* Recursively handle derived type components.  */
-  if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
+  else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
     init = gfc_generate_initializer (&c->ts, true);
 
   else if (c->ts.type == BT_UNION && c->ts.u.derived->components)
@@ -4391,7 +4562,8 @@
   /* Treat simple components like locals.  */
   else
     {
-      init = gfc_build_default_init_expr (&c->ts, &c->loc);
+      /* We MUST give an initializer, so force generation.  */
+      init = gfc_build_init_expr (&c->ts, &c->loc, true);
       gfc_apply_init (&c->ts, &c->attr, init);
     }
 
@@ -4407,6 +4579,32 @@
   return gfc_generate_initializer (ts, false);
 }
 
+/* Generate an initializer expression for an iso_c_binding type
+   such as c_[fun]ptr. The appropriate initializer is c_null_[fun]ptr.  */
+
+static gfc_expr *
+generate_isocbinding_initializer (gfc_symbol *derived)
+{
+  /* The initializers have already been built into the c_null_[fun]ptr symbols
+     from gen_special_c_interop_ptr.  */
+  gfc_symtree *npsym = NULL;
+  if (0 == strcmp (derived->name, "c_ptr"))
+    gfc_find_sym_tree ("c_null_ptr", gfc_current_ns, true, &npsym);
+  else if (0 == strcmp (derived->name, "c_funptr"))
+    gfc_find_sym_tree ("c_null_funptr", gfc_current_ns, true, &npsym);
+  else
+    gfc_internal_error ("generate_isocbinding_initializer(): bad iso_c_binding"
+			" type, expected %<c_ptr%> or %<c_funptr%>");
+  if (npsym)
+    {
+      gfc_expr *init = gfc_copy_expr (npsym->n.sym->value);
+      init->symtree = npsym;
+      init->ts.is_iso_c = true;
+      return init;
+    }
+
+  return NULL;
+}
 
 /* Get or generate an expression for a default initializer of a derived type.
    If -finit-derived is specified, generate default initialization expressions
@@ -4417,8 +4615,12 @@
 {
   gfc_expr *init, *tmp;
   gfc_component *comp;
+
   generate = flag_init_derived && generate;
 
+  if (ts->u.derived->ts.is_iso_c && generate)
+    return generate_isocbinding_initializer (ts->u.derived);
+
   /* See if we have a default initializer in this, but not in nested
      types (otherwise we could use gfc_has_default_initializer()).
      We don't need to check if we are going to generate them.  */
@@ -4426,9 +4628,7 @@
   if (!generate)
     {
       for (; comp; comp = comp->next)
-        if (comp->initializer || comp->attr.allocatable
-            || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)
-                && CLASS_DATA (comp)->attr.allocatable))
+	if (comp->initializer || comp_allocatable (comp))
           break;
     }
 
@@ -4444,7 +4644,7 @@
       gfc_constructor *ctor = gfc_constructor_get();
 
       /* Fetch or generate an initializer for the component.  */
-      tmp = component_initializer (ts, comp, generate);
+      tmp = component_initializer (comp, generate);
       if (tmp)
 	{
 	  /* Save the component ref for STRUCTUREs and UNIONs.  */
@@ -4454,8 +4654,7 @@
 
           /* If the initializer was not generated, we need a copy.  */
           ctor->expr = comp->initializer ? gfc_copy_expr (tmp) : tmp;
-	  if ((comp->ts.type != tmp->ts.type
-	       || comp->ts.kind != tmp->ts.kind)
+	  if ((comp->ts.type != tmp->ts.type || comp->ts.kind != tmp->ts.kind)
 	      && !comp->attr.pointer && !comp->attr.proc_pointer)
 	    {
 	      bool val;
@@ -4465,15 +4664,6 @@
 	    }
 	}
 
-      if (comp->attr.allocatable
-	  || (comp->ts.type == BT_CLASS && CLASS_DATA (comp)->attr.allocatable))
-	{
-	  ctor->expr = gfc_get_expr ();
-	  ctor->expr->expr_type = EXPR_NULL;
-	  ctor->expr->where = init->where;
-	  ctor->expr->ts = comp->ts;
-	}
-
       gfc_constructor_append (&init->value.constructor, ctor);
     }
 
@@ -4822,14 +5012,15 @@
 /* Determine if an expression is a function with an allocatable class array
    result.  */
 bool
-gfc_is_alloc_class_array_function (gfc_expr *expr)
+gfc_is_class_array_function (gfc_expr *expr)
 {
   if (expr->expr_type == EXPR_FUNCTION
       && expr->value.function.esym
       && expr->value.function.esym->result
       && expr->value.function.esym->result->ts.type == BT_CLASS
       && CLASS_DATA (expr->value.function.esym->result)->attr.dimension
-      && CLASS_DATA (expr->value.function.esym->result)->attr.allocatable)
+      && (CLASS_DATA (expr->value.function.esym->result)->attr.allocatable
+	  || CLASS_DATA (expr->value.function.esym->result)->attr.pointer))
     return true;
 
   return false;
@@ -4983,7 +5174,25 @@
 }
 
 gfc_expr *
-gfc_find_stat_co(gfc_expr *e)
+gfc_find_team_co (gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+      return ref->u.ar.team;
+
+  if (e->value.function.actual->expr)
+    for (ref = e->value.function.actual->expr->ref; ref;
+	 ref = ref->next)
+      if (ref->type == REF_ARRAY && ref->u.ar.codimen > 0)
+	return ref->u.ar.team;
+
+  return NULL;
+}
+
+gfc_expr *
+gfc_find_stat_co (gfc_expr *e)
 {
   gfc_ref *ref;
 
@@ -5185,8 +5394,28 @@
   gfc_symbol *sym;
 
   if (expr->expr_type == EXPR_FUNCTION)
-    return expr->value.function.esym
-	   ? expr->value.function.esym->result->attr.contiguous : false;
+    {
+      if (expr->value.function.esym)
+	return expr->value.function.esym->result->attr.contiguous;
+      else
+	{
+	  /* Type-bound procedures.  */
+	  gfc_symbol *s = expr->symtree->n.sym;
+	  if (s->ts.type != BT_CLASS && s->ts.type != BT_DERIVED)
+	    return false;
+
+	  gfc_ref *rc = NULL;
+	  for (gfc_ref *r = expr->ref; r; r = r->next)
+	    if (r->type == REF_COMPONENT)
+	      rc = r;
+
+	  if (rc == NULL || rc->u.c.component == NULL
+	      || rc->u.c.component->ts.interface == NULL)
+	    return false;
+
+	  return rc->u.c.component->ts.interface->attr.contiguous;
+	}
+    }
   else if (expr->expr_type != EXPR_VARIABLE)
     return false;
 
@@ -5208,14 +5437,14 @@
 
   sym = expr->symtree->n.sym;
   if (expr->ts.type != BT_CLASS
-	&& ((part_ref
-		&& !part_ref->u.c.component->attr.contiguous
-		&& part_ref->u.c.component->attr.pointer)
-	    || (!part_ref
-		&& !sym->attr.contiguous
-		&& (sym->attr.pointer
-		    || sym->as->type == AS_ASSUMED_RANK
-		    || sym->as->type == AS_ASSUMED_SHAPE))))
+      && ((part_ref
+	   && !part_ref->u.c.component->attr.contiguous
+	   && part_ref->u.c.component->attr.pointer)
+	  || (!part_ref
+	      && !sym->attr.contiguous
+	      && (sym->attr.pointer
+		  || (sym->as && sym->as->type == AS_ASSUMED_RANK)
+		  || (sym->as && sym->as->type == AS_ASSUMED_SHAPE)))))
     return false;
 
   if (!ar || ar->type == AR_FULL)