--- a/gcc/fortran/trans-types.c	Fri Oct 27 22:46:09 2017 +0900
+++ b/gcc/fortran/trans-types.c	Thu Oct 25 07:37:49 2018 +0900
@@ -1,5 +1,5 @@
 /* Backend support for Fortran 95 basic types and derived types.
-   Copyright (C) 2002-2017 Free Software Foundation, Inc.
+   Copyright (C) 2002-2018 Free Software Foundation, Inc.
    Contributed by Paul Brook <paul@nowt.org>
    and Steven Bosscher <s.bosscher@student.tudelft.nl>
 
@@ -62,6 +62,9 @@
 tree pchar_type_node;
 tree pfunc_type_node;
 
+tree logical_type_node;
+tree logical_true_node;
+tree logical_false_node;
 tree gfc_charlen_type_node;
 
 tree gfc_float128_type_node = NULL_TREE;
@@ -120,10 +123,54 @@
 /* The integer kind used to store character lengths.  */
 int gfc_charlen_int_kind;
 
+/* Kind of internal integer for storing object sizes.  */
+int gfc_size_kind;
+
 /* The size of the numeric storage unit and character storage unit.  */
 int gfc_numeric_storage_size;
 int gfc_character_storage_size;
 
+tree dtype_type_node = NULL_TREE;
+
+
+/* Build the dtype_type_node if necessary.  */
+tree get_dtype_type_node (void)
+{
+  tree field;
+  tree dtype_node;
+  tree *dtype_chain = NULL;
+
+  if (dtype_type_node == NULL_TREE)
+    {
+      dtype_node = make_node (RECORD_TYPE);
+      TYPE_NAME (dtype_node) = get_identifier ("dtype_type");
+      TYPE_NAMELESS (dtype_node) = 1;
+      field = gfc_add_field_to_struct_1 (dtype_node,
+					 get_identifier ("elem_len"),
+					 size_type_node, &dtype_chain);
+      TREE_NO_WARNING (field) = 1;
+      field = gfc_add_field_to_struct_1 (dtype_node,
+					 get_identifier ("version"),
+					 integer_type_node, &dtype_chain);
+      TREE_NO_WARNING (field) = 1;
+      field = gfc_add_field_to_struct_1 (dtype_node,
+					 get_identifier ("rank"),
+					 signed_char_type_node, &dtype_chain);
+      TREE_NO_WARNING (field) = 1;
+      field = gfc_add_field_to_struct_1 (dtype_node,
+					 get_identifier ("type"),
+					 signed_char_type_node, &dtype_chain);
+      TREE_NO_WARNING (field) = 1;
+      field = gfc_add_field_to_struct_1 (dtype_node,
+					 get_identifier ("attribute"),
+					 short_integer_type_node, &dtype_chain);
+      TREE_NO_WARNING (field) = 1;
+      gfc_finish_type (dtype_node);
+      TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (dtype_node)) = 1;
+      dtype_type_node = dtype_node;
+    }
+  return dtype_type_node;
+}
 
 bool
 gfc_check_any_c_kind (gfc_typespec *ts)
@@ -171,43 +218,6 @@
   return -1;
 }
 
-/* Return a typenode for the "standard" C type with a given name.  */
-static tree
-get_typenode_from_name (const char *name)
-{
-  if (name == NULL || *name == '\0')
-    return NULL_TREE;
-
-  if (strcmp (name, "char") == 0)
-    return char_type_node;
-  if (strcmp (name, "unsigned char") == 0)
-    return unsigned_char_type_node;
-  if (strcmp (name, "signed char") == 0)
-    return signed_char_type_node;
-
-  if (strcmp (name, "short int") == 0)
-    return short_integer_type_node;
-  if (strcmp (name, "short unsigned int") == 0)
-    return short_unsigned_type_node;
-
-  if (strcmp (name, "int") == 0)
-    return integer_type_node;
-  if (strcmp (name, "unsigned int") == 0)
-    return unsigned_type_node;
-
-  if (strcmp (name, "long int") == 0)
-    return long_integer_type_node;
-  if (strcmp (name, "long unsigned int") == 0)
-    return long_unsigned_type_node;
-
-  if (strcmp (name, "long long int") == 0)
-    return long_long_integer_type_node;
-  if (strcmp (name, "long long unsigned int") == 0)
-    return long_long_unsigned_type_node;
-
-  gcc_unreachable ();
-}
-
 static int
 get_int_kind_from_name (const char *name)
 {
@@ -997,15 +1007,23 @@
      by the number of bits available to store this field in the array
      descriptor.  */
 
-  n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
+  n = TYPE_PRECISION (size_type_node);
   gfc_max_array_element_size
     = wide_int_to_tree (size_type_node,
 			wi::mask (n, UNSIGNED,
 				  TYPE_PRECISION (size_type_node)));
 
-  /* ??? Shouldn't this be based on gfc_index_integer_kind or so?  */
-  gfc_charlen_int_kind = 4;
+  logical_type_node = gfc_get_logical_type (gfc_default_logical_kind);
+  logical_true_node = build_int_cst (logical_type_node, 1);
+  logical_false_node = build_int_cst (logical_type_node, 0);
+
+  /* Character lengths are of type size_t, except signed.  */
+  gfc_charlen_int_kind = get_int_kind_from_node (size_type_node);
   gfc_charlen_type_node = gfc_get_int_type (gfc_charlen_int_kind);
+
+  /* Fortran kind number of size_type_node (size_t). This is used for
+     the _size member in vtables.  */
+  gfc_size_kind = get_int_kind_from_node (size_type_node);
 }
 
 /* Get the type node for the given type and kind.  */
@@ -1241,12 +1259,21 @@
 
     struct gfc_array_descriptor
     {
-      array *data
+      array *data;
       index offset;
-      index dtype;
+      struct dtype_type dtype;
       struct descriptor_dimension dimension[N_DIM];
     }
 
+    struct dtype_type
+    {
+      size_t elem_len;
+      int version;
+      signed char rank;
+      signed char type;
+      signed short attribute;
+    }
+
     struct descriptor_dimension
     {
       index stride;
@@ -1263,11 +1290,6 @@
    are gfc_array_index_type and the data node is a pointer to the
    data.  See below for the handling of character types.
 
-   The dtype member is formatted as follows:
-    rank = dtype & GFC_DTYPE_RANK_MASK // 3 bits
-    type = (dtype & GFC_DTYPE_TYPE_MASK) >> GFC_DTYPE_TYPE_SHIFT // 3 bits
-    size = dtype >> GFC_DTYPE_SIZE_SHIFT
-
    I originally used nested ARRAY_TYPE nodes to represent arrays, but
    this generated poor code for assumed/deferred size arrays.  These
    require use of PLACEHOLDER_EXPR/WITH_RECORD_EXPR, which isn't part
@@ -1454,9 +1476,12 @@
 {
   tree size;
   int n;
-  HOST_WIDE_INT i;
   tree tmp;
   tree dtype;
+  tree field;
+  vec<constructor_elt, va_gc> *v = NULL;
+
+  size = TYPE_SIZE_UNIT (etype);
 
   switch (TREE_CODE (etype))
     {
@@ -1476,51 +1501,51 @@
       n = BT_COMPLEX;
       break;
 
+    case RECORD_TYPE:
+      if (GFC_CLASS_TYPE_P (etype))
+	n = BT_CLASS;
+      else
+	n = BT_DERIVED;
+      break;
+
     /* We will never have arrays of arrays.  */
-    case RECORD_TYPE:
-      n = BT_DERIVED;
-      break;
-
     case ARRAY_TYPE:
       n = BT_CHARACTER;
+      if (size == NULL_TREE)
+	size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
       break;
 
     case POINTER_TYPE:
       n = BT_ASSUMED;
-      break;
+      if (TREE_CODE (TREE_TYPE (etype)) != VOID_TYPE)
+	size = TYPE_SIZE_UNIT (TREE_TYPE (etype));
+      else
+	size = build_int_cst (size_type_node, 0);
+    break;
 
     default:
       /* TODO: Don't do dtype for temporary descriptorless arrays.  */
-      /* We can strange array types for temporary arrays.  */
+      /* We can encounter strange array types for temporary arrays.  */
       return gfc_index_zero_node;
     }
 
-  gcc_assert (rank <= GFC_DTYPE_RANK_MASK);
-  size = TYPE_SIZE_UNIT (etype);
-
-  i = rank | (n << GFC_DTYPE_TYPE_SHIFT);
-  if (size && INTEGER_CST_P (size))
-    {
-      if (tree_int_cst_lt (gfc_max_array_element_size, size))
-	gfc_fatal_error ("Array element size too big at %C");
-
-      i += TREE_INT_CST_LOW (size) << GFC_DTYPE_SIZE_SHIFT;
-    }
-  dtype = build_int_cst (gfc_array_index_type, i);
-
-  if (size && !INTEGER_CST_P (size))
-    {
-      tmp = build_int_cst (gfc_array_index_type, GFC_DTYPE_SIZE_SHIFT);
-      tmp  = fold_build2_loc (input_location, LSHIFT_EXPR,
-			      gfc_array_index_type,
-			      fold_convert (gfc_array_index_type, size), tmp);
-      dtype = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-			       tmp, dtype);
-    }
-  /* If we don't know the size we leave it as zero.  This should never happen
-     for anything that is actually used.  */
-  /* TODO: Check this is actually true, particularly when repacking
-     assumed size parameters.  */
+  tmp = get_dtype_type_node ();
+  field = gfc_advance_chain (TYPE_FIELDS (tmp),
+			     GFC_DTYPE_ELEM_LEN);
+  CONSTRUCTOR_APPEND_ELT (v, field,
+			  fold_convert (TREE_TYPE (field), size));
+
+  field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
+			     GFC_DTYPE_RANK);
+  CONSTRUCTOR_APPEND_ELT (v, field,
+			  build_int_cst (TREE_TYPE (field), rank));
+
+  field = gfc_advance_chain (TYPE_FIELDS (dtype_type_node),
+			     GFC_DTYPE_TYPE);
+  CONSTRUCTOR_APPEND_ELT (v, field,
+			  build_int_cst (TREE_TYPE (field), n));
+
+  dtype = build_constructor (tmp, v);
 
   return dtype;
 }
@@ -1535,9 +1560,6 @@
 
   gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type));
 
-  if (GFC_TYPE_ARRAY_DTYPE (type))
-    return GFC_TYPE_ARRAY_DTYPE (type);
-
   rank = GFC_TYPE_ARRAY_RANK (type);
   etype = gfc_get_element_type (type);
   dtype = gfc_get_dtype_rank_type (rank, etype);
@@ -1806,7 +1828,7 @@
   /* Add the dtype component.  */
   decl = gfc_add_field_to_struct_1 (fat_type,
 				    get_identifier ("dtype"),
-				    gfc_array_index_type, &chain);
+				    get_dtype_type_node (), &chain);
   TREE_NO_WARNING (decl) = 1;
 
   /* Add the span component.  */
@@ -1829,7 +1851,7 @@
       TREE_NO_WARNING (decl) = 1;
     }
 
-  if (flag_coarray == GFC_FCOARRAY_LIB && codimen)
+  if (flag_coarray == GFC_FCOARRAY_LIB)
     {
       decl = gfc_add_field_to_struct_1 (fat_type,
 					get_identifier ("token"),
@@ -1864,6 +1886,14 @@
 
   base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted);
   fat_type = build_distinct_type_copy (base_type);
+  /* Unshare TYPE_FIELDs.  */
+  for (tree *tp = &TYPE_FIELDS (fat_type); *tp; tp = &DECL_CHAIN (*tp))
+    {
+      tree next = DECL_CHAIN (*tp);
+      *tp = copy_node (*tp);
+      DECL_CONTEXT (*tp) = fat_type;
+      DECL_CHAIN (*tp) = next;
+    }
   /* Make sure that nontarget and target array type have the same canonical
      type (and same stub decl for debug info).  */
   base_type = gfc_get_array_descriptor_base (dimen, codimen, false);
@@ -2193,6 +2223,14 @@
   if (sym->backend_decl && !sym->attr.function)
     return TREE_TYPE (sym->backend_decl);
 
+  if (sym->attr.result
+      && sym->ts.type == BT_CHARACTER
+      && sym->ts.u.cl->backend_decl == NULL_TREE
+      && sym->ns->proc_name
+      && sym->ns->proc_name->ts.u.cl
+      && sym->ns->proc_name->ts.u.cl->backend_decl != NULL_TREE)
+    sym->ts.u.cl->backend_decl = sym->ns->proc_name->ts.u.cl->backend_decl;
+
   if (sym->ts.type == BT_CHARACTER
       && ((sym->attr.function && sym->attr.is_bind_c)
 	  || (sym->attr.result
@@ -2359,6 +2397,7 @@
   for (; to_cm; to_cm = to_cm->next, from_cm = from_cm->next)
     {
       to_cm->backend_decl = from_cm->backend_decl;
+      to_cm->caf_token = from_cm->caf_token;
       if (from_cm->ts.type == BT_UNION)
         gfc_get_union_type (to_cm->ts.u.derived);
       else if (from_cm->ts.type == BT_DERIVED
@@ -2466,9 +2505,12 @@
   bool got_canonical = false;
   bool unlimited_entity = false;
   gfc_component *c;
-  gfc_dt_list *dt;
   gfc_namespace *ns;
   tree tmp;
+  bool coarray_flag;
+
+  coarray_flag = flag_coarray == GFC_FCOARRAY_LIB
+		 && derived->module && !derived->attr.vtype;
 
   gcc_assert (!derived->attr.pdt_template);
 
@@ -2476,12 +2518,14 @@
       || (flag_coarray == GFC_FCOARRAY_LIB
 	  && derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
 	  && (derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE
-	      || derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)))
+	      || derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE
+	      || derived->intmod_sym_id == ISOFORTRAN_TEAM_TYPE)))
     return ptr_type_node;
 
   if (flag_coarray != GFC_FCOARRAY_LIB
       && derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
-      && derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
+      && (derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE
+	  || derived->intmod_sym_id == ISOFORTRAN_TEAM_TYPE))
     return gfc_get_int_type (gfc_default_integer_kind);
 
   if (derived && derived->attr.flavor == FL_PROCEDURE
@@ -2525,14 +2569,19 @@
 	   ns->translated && !got_canonical;
 	   ns = ns->sibling)
 	{
-	  dt = ns->derived_types;
-	  for (; dt && !canonical; dt = dt->next)
+	  if (ns->derived_types)
 	    {
-	      gfc_copy_dt_decls_ifequal (dt->derived, derived, true);
-	      if (derived->backend_decl)
-		got_canonical = true;
-	    }
-	}
+	      for (gfc_symbol *dt = ns->derived_types; dt && !got_canonical;
+		   dt = dt->dt_next)
+		{
+		  gfc_copy_dt_decls_ifequal (dt, derived, true);
+		  if (derived->backend_decl)
+		    got_canonical = true;
+		  if (dt->dt_next == ns->derived_types)
+		    break;
+		}
+ 	    }
+ 	}
     }
 
   /* Store up the canonical type to be added to this one.  */
@@ -2663,7 +2712,9 @@
 	  field_type = build_pointer_type (tmp);
 	}
       else if (c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS)
-        field_type = c->ts.u.derived->backend_decl;
+	field_type = c->ts.u.derived->backend_decl;
+      else if (c->attr.caf_token)
+	field_type = pvoid_type_node;
       else
 	{
 	  if (c->ts.type == BT_CHARACTER
@@ -2748,19 +2799,6 @@
 	  && !(c->ts.type == BT_DERIVED
 	       && strcmp (c->name, "_data") == 0))
 	GFC_DECL_PTR_ARRAY_P (c->backend_decl) = 1;
-
-      /* Do not add a caf_token field for classes' data components.  */
-      if (codimen && !c->attr.dimension && !c->attr.codimension
-	  && (c->attr.allocatable || c->attr.pointer)
-	  && c->caf_token == NULL_TREE && strcmp ("_data", c->name) != 0)
-	{
-	  char caf_name[GFC_MAX_SYMBOL_LEN];
-	  snprintf (caf_name, GFC_MAX_SYMBOL_LEN, "_caf_%s", c->name);
-	  c->caf_token = gfc_add_field_to_struct (typenode,
-						  get_identifier (caf_name),
-						  pvoid_type_node, &chain);
-	  TREE_NO_WARNING (c->caf_token) = 1;
-	}
     }
 
   /* Now lay out the derived type, including the fields.  */
@@ -2786,8 +2824,30 @@
 
 copy_derived_types:
 
-  for (dt = gfc_derived_types; dt; dt = dt->next)
-    gfc_copy_dt_decls_ifequal (derived, dt->derived, false);
+  for (c = derived->components; c; c = c->next)
+    {
+      /* Do not add a caf_token field for class container components.  */
+      if ((codimen || coarray_flag)
+	  && !c->attr.dimension && !c->attr.codimension
+	  && (c->attr.allocatable || c->attr.pointer)
+	  && !derived->attr.is_class)
+	{
+	  char caf_name[GFC_MAX_SYMBOL_LEN];
+	  gfc_component *token;
+	  snprintf (caf_name, GFC_MAX_SYMBOL_LEN, "_caf_%s", c->name);
+	  token = gfc_find_component (derived, caf_name, true, true, NULL);
+	  gcc_assert (token);
+	  c->caf_token = token->backend_decl;
+	  TREE_NO_WARNING (c->caf_token) = 1;
+	}
+    }
+
+  for (gfc_symbol *dt = gfc_derived_types; dt; dt = dt->dt_next)
+    {
+      gfc_copy_dt_decls_ifequal (derived, dt, false);
+      if (dt->dt_next == gfc_derived_types)
+	break;
+    }
 
   return derived->backend_decl;
 }
@@ -3159,7 +3219,16 @@
       tree type = gfc_type_for_size (GET_MODE_PRECISION (int_mode), unsignedp);
       return type != NULL_TREE && mode == TYPE_MODE (type) ? type : NULL_TREE;
     }
-  else if (VECTOR_MODE_P (mode))
+  else if (GET_MODE_CLASS (mode) == MODE_VECTOR_BOOL
+	   && valid_vector_subparts_p (GET_MODE_NUNITS (mode)))
+    {
+      unsigned int elem_bits = vector_element_size (GET_MODE_BITSIZE (mode),
+						    GET_MODE_NUNITS (mode));
+      tree bool_type = build_nonstandard_boolean_type (elem_bits);
+      return build_vector_type_for_mode (bool_type, mode);
+    }
+  else if (VECTOR_MODE_P (mode)
+	   && valid_vector_subparts_p (GET_MODE_NUNITS (mode)))
     {
       machine_mode inner_mode = GET_MODE_INNER (mode);
       tree inner_type = gfc_type_for_mode (inner_mode, unsignedp);
@@ -3191,6 +3260,7 @@
   tree etype, ptype, t, base_decl;
   tree data_off, dim_off, dtype_off, dim_size, elem_size;
   tree lower_suboff, upper_suboff, stride_suboff;
+  tree dtype, field, rank_off;
 
   if (! GFC_DESCRIPTOR_TYPE_P (type))
     {
@@ -3257,11 +3327,11 @@
   t = build1 (NOP_EXPR, build_pointer_type (ptr_type_node), t);
   info->data_location = build1 (INDIRECT_REF, ptr_type_node, t);
   if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE)
-    info->allocated = build2 (NE_EXPR, boolean_type_node,
+    info->allocated = build2 (NE_EXPR, logical_type_node,
 			      info->data_location, null_pointer_node);
   else if (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER
 	   || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)
-    info->associated = build2 (NE_EXPR, boolean_type_node,
+    info->associated = build2 (NE_EXPR, logical_type_node,
 			       info->data_location, null_pointer_node);
   if ((GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK
        || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT)
@@ -3272,11 +3342,15 @@
       t = base_decl;
       if (!integer_zerop (dtype_off))
 	t = fold_build_pointer_plus (t, dtype_off);
+      dtype = TYPE_MAIN_VARIANT (get_dtype_type_node ());
+      field = gfc_advance_chain (TYPE_FIELDS (dtype), GFC_DTYPE_RANK);
+      rank_off = byte_position (field);
+      if (!integer_zerop (dtype_off))
+	t = fold_build_pointer_plus (t, rank_off);
+
       t = build1 (NOP_EXPR, build_pointer_type (gfc_array_index_type), t);
       t = build1 (INDIRECT_REF, gfc_array_index_type, t);
-      info->rank = build2 (BIT_AND_EXPR, gfc_array_index_type, t,
-			   build_int_cst (gfc_array_index_type,
-					  GFC_DTYPE_RANK_MASK));
+      info->rank = t;
       t = build0 (PLACEHOLDER_EXPR, TREE_TYPE (dim_off));
       t = size_binop (MULT_EXPR, t, dim_size);
       dim_off = build2 (PLUS_EXPR, TREE_TYPE (dim_off), t, dim_off);