--- a/gcc/fortran/trans-stmt.c	Fri Oct 27 22:46:09 2017 +0900
+++ b/gcc/fortran/trans-stmt.c	Thu Oct 25 07:37:49 2018 +0900
@@ -1,5 +1,5 @@
 /* Statement translation -- generate GCC trees from gfc_code.
-   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>
 
@@ -112,7 +112,7 @@
       || code->label1->defined == ST_LABEL_DO_TARGET)
     {
       label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
-      len_tree = integer_minus_one_node;
+      len_tree = build_int_cst (gfc_charlen_type_node, -1);
     }
   else
     {
@@ -125,7 +125,7 @@
       label_tree = gfc_build_addr_expr (pvoid_type_node, label_tree);
     }
 
-  gfc_add_modify (&se.pre, len, len_tree);
+  gfc_add_modify (&se.pre, len, fold_convert (TREE_TYPE (len), len_tree));
   gfc_add_modify (&se.pre, addr, label_tree);
 
   return gfc_finish_block (&se.pre);
@@ -150,7 +150,7 @@
   gfc_start_block (&se.pre);
   gfc_conv_label_variable (&se, code->expr1);
   tmp = GFC_DECL_STRING_LEN (se.expr);
-  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, tmp,
+  tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node, tmp,
 			 build_int_cst (TREE_TYPE (tmp), -1));
   gfc_trans_runtime_check (true, false, tmp, &se.pre, &loc,
 			   "Assigned label is not a target label");
@@ -578,7 +578,7 @@
 tree
 gfc_trans_pause (gfc_code * code)
 {
-  tree gfc_int4_type_node = gfc_get_int_type (4);
+  tree gfc_int8_type_node = gfc_get_int_type (8);
   gfc_se se;
   tree tmp;
 
@@ -589,7 +589,7 @@
 
   if (code->expr1 == NULL)
     {
-      tmp = build_int_cst (gfc_int4_type_node, 0);
+      tmp = build_int_cst (size_type_node, 0);
       tmp = build_call_expr_loc (input_location,
 				 gfor_fndecl_pause_string, 2,
 				 build_int_cst (pchar_type_node, 0), tmp);
@@ -599,14 +599,15 @@
       gfc_conv_expr (&se, code->expr1);
       tmp = build_call_expr_loc (input_location,
 				 gfor_fndecl_pause_numeric, 1,
-				 fold_convert (gfc_int4_type_node, se.expr));
+				 fold_convert (gfc_int8_type_node, se.expr));
     }
   else
     {
       gfc_conv_expr_reference (&se, code->expr1);
       tmp = build_call_expr_loc (input_location,
 			     gfor_fndecl_pause_string, 2,
-			     se.expr, se.string_length);
+				 se.expr, fold_convert (size_type_node,
+							se.string_length));
     }
 
   gfc_add_expr_to_block (&se.pre, tmp);
@@ -623,7 +624,6 @@
 tree
 gfc_trans_stop (gfc_code *code, bool error_stop)
 {
-  tree gfc_int4_type_node = gfc_get_int_type (4);
   gfc_se se;
   tree tmp;
 
@@ -633,7 +633,7 @@
 
   if (code->expr1 == NULL)
     {
-      tmp = build_int_cst (gfc_int4_type_node, 0);
+      tmp = build_int_cst (size_type_node, 0);
       tmp = build_call_expr_loc (input_location,
 				 error_stop
 				 ? (flag_coarray == GFC_FCOARRAY_LIB
@@ -642,7 +642,8 @@
 				 : (flag_coarray == GFC_FCOARRAY_LIB
 				    ? gfor_fndecl_caf_stop_str
 				    : gfor_fndecl_stop_string),
-				 2, build_int_cst (pchar_type_node, 0), tmp);
+				 3, build_int_cst (pchar_type_node, 0), tmp,
+				 boolean_false_node);
     }
   else if (code->expr1->ts.type == BT_INTEGER)
     {
@@ -654,8 +655,9 @@
 				    : gfor_fndecl_error_stop_numeric)
 				 : (flag_coarray == GFC_FCOARRAY_LIB
 				    ? gfor_fndecl_caf_stop_numeric
-				    : gfor_fndecl_stop_numeric), 1,
-				 fold_convert (gfc_int4_type_node, se.expr));
+				    : gfor_fndecl_stop_numeric), 2,
+				 fold_convert (integer_type_node, se.expr),
+				 boolean_false_node);
     }
   else
     {
@@ -668,7 +670,9 @@
 				 : (flag_coarray == GFC_FCOARRAY_LIB
 				    ? gfor_fndecl_caf_stop_str
 				    : gfor_fndecl_stop_string),
-				 2, se.expr, se.string_length);
+				 3, se.expr, fold_convert (size_type_node,
+							   se.string_length),
+				 boolean_false_node);
     }
 
   gfc_add_expr_to_block (&se.pre, tmp);
@@ -696,6 +700,127 @@
     }
 }
 
+/* Translate the FORM TEAM statement.  */
+
+tree
+gfc_trans_form_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se se;
+      gfc_se argse1, argse2;
+      tree team_id, team_type, tmp;
+
+      gfc_init_se (&se, NULL);
+      gfc_init_se (&argse1, NULL);
+      gfc_init_se (&argse2, NULL);
+      gfc_start_block (&se.pre);
+
+      gfc_conv_expr_val (&argse1, code->expr1);
+      gfc_conv_expr_val (&argse2, code->expr2);
+      team_id = fold_convert (integer_type_node, argse1.expr);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse2.expr);
+
+      gfc_add_block_to_block (&se.pre, &argse1.pre);
+      gfc_add_block_to_block (&se.pre, &argse2.pre);
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_form_team, 3,
+				 team_id, team_type,
+				 build_int_cst (integer_type_node, 0));
+      gfc_add_expr_to_block (&se.pre, tmp);
+      gfc_add_block_to_block (&se.pre, &argse1.post);
+      gfc_add_block_to_block (&se.pre, &argse2.post);
+      return gfc_finish_block (&se.pre);
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the CHANGE TEAM statement.  */
+
+tree
+gfc_trans_change_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se argse;
+      tree team_type, tmp;
+
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr1);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_change_team, 2, team_type,
+				 build_int_cst (integer_type_node, 0));
+      gfc_add_expr_to_block (&argse.pre, tmp);
+      gfc_add_block_to_block (&argse.pre, &argse.post);
+      return gfc_finish_block (&argse.pre);
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the END TEAM statement.  */
+
+tree
+gfc_trans_end_team (gfc_code *code ATTRIBUTE_UNUSED)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      return build_call_expr_loc (input_location,
+				  gfor_fndecl_caf_end_team, 1,
+				  build_int_cst (pchar_type_node, 0));
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
+
+/* Translate the SYNC TEAM statement.  */
+
+tree
+gfc_trans_sync_team (gfc_code *code)
+{
+  if (flag_coarray == GFC_FCOARRAY_LIB)
+    {
+      gfc_se argse;
+      tree team_type, tmp;
+
+      gfc_init_se (&argse, NULL);
+      gfc_conv_expr_val (&argse, code->expr1);
+      team_type = gfc_build_addr_expr (ppvoid_type_node, argse.expr);
+
+      tmp = build_call_expr_loc (input_location,
+				 gfor_fndecl_caf_sync_team, 2,
+				 team_type,
+				 build_int_cst (integer_type_node, 0));
+      gfc_add_expr_to_block (&argse.pre, tmp);
+      gfc_add_block_to_block (&argse.pre, &argse.post);
+      return gfc_finish_block (&argse.pre);
+    }
+  else
+    {
+      const char *name = gfc_get_string (PREFIX ("exit_i%d"), 4);
+      gfc_symbol *exsym = gfc_get_intrinsic_sub_symbol (name);
+      tree tmp = gfc_get_symbol_decl (exsym);
+      return build_call_expr_loc (input_location, tmp, 1, integer_zero_node);
+    }
+}
 
 tree
 gfc_trans_lock_unlock (gfc_code *code, gfc_exec_op op)
@@ -733,7 +858,7 @@
   if (flag_coarray == GFC_FCOARRAY_LIB)
     {
       tree tmp, token, image_index, errmsg, errmsg_len;
-      tree index = size_zero_node;
+      tree index = build_zero_cst (gfc_array_index_type);
       tree caf_decl = gfc_get_tree_for_caf_expr (code->expr1);
 
       if (code->expr1->symtree->n.sym->ts.type != BT_DERIVED
@@ -776,27 +901,25 @@
 	  desc = argse.expr;
 	  *ar = ar2;
 
-	  extent = integer_one_node;
+	  extent = build_one_cst (gfc_array_index_type);
 	  for (i = 0; i < ar->dimen; i++)
 	    {
 	      gfc_init_se (&argse, NULL);
-	      gfc_conv_expr_type (&argse, ar->start[i], integer_type_node);
+	      gfc_conv_expr_type (&argse, ar->start[i], gfc_array_index_type);
 	      gfc_add_block_to_block (&argse.pre, &argse.pre);
 	      lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
 	      tmp = fold_build2_loc (input_location, MINUS_EXPR,
-				     integer_type_node, argse.expr,
-				     fold_convert(integer_type_node, lbound));
+				     TREE_TYPE (lbound), argse.expr, lbound);
 	      tmp = fold_build2_loc (input_location, MULT_EXPR,
-				     integer_type_node, extent, tmp);
+				     TREE_TYPE (tmp), extent, tmp);
 	      index = fold_build2_loc (input_location, PLUS_EXPR,
-				       integer_type_node, index, tmp);
+				       TREE_TYPE (tmp), index, tmp);
 	      if (i < ar->dimen - 1)
 		{
 		  ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
 		  tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
-		  tmp = fold_convert (integer_type_node, tmp);
 		  extent = fold_build2_loc (input_location, MULT_EXPR,
-					    integer_type_node, extent, tmp);
+					    TREE_TYPE (tmp), extent, tmp);
 		}
 	    }
 	}
@@ -809,12 +932,12 @@
 	  gfc_conv_expr (&argse, code->expr3);
 	  gfc_add_block_to_block (&se.pre, &argse.pre);
 	  errmsg = argse.expr;
-	  errmsg_len = fold_convert (integer_type_node, argse.string_length);
+	  errmsg_len = fold_convert (size_type_node, argse.string_length);
 	}
       else
 	{
 	  errmsg = null_pointer_node;
-	  errmsg_len = integer_zero_node;
+	  errmsg_len = build_zero_cst (size_type_node);
 	}
 
       if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
@@ -830,6 +953,7 @@
 	  lock_acquired = gfc_create_var (integer_type_node, "acquired");
 	}
 
+      index = fold_convert (size_type_node, index);
       if (op == EXEC_LOCK)
 	tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_lock, 7,
                                    token, index, image_index,
@@ -930,7 +1054,7 @@
 
   gfc_start_block (&se.pre);
   tree tmp, token, image_index, errmsg, errmsg_len;
-  tree index = size_zero_node;
+  tree index = build_zero_cst (gfc_array_index_type);
   tree caf_decl = gfc_get_tree_for_caf_expr (code->expr1);
 
   if (code->expr1->symtree->n.sym->ts.type != BT_DERIVED
@@ -975,27 +1099,25 @@
       desc = argse.expr;
       *ar = ar2;
 
-      extent = integer_one_node;
+      extent = build_one_cst (gfc_array_index_type);
       for (i = 0; i < ar->dimen; i++)
 	{
 	  gfc_init_se (&argse, NULL);
-	  gfc_conv_expr_type (&argse, ar->start[i], integer_type_node);
+	  gfc_conv_expr_type (&argse, ar->start[i], gfc_array_index_type);
 	  gfc_add_block_to_block (&argse.pre, &argse.pre);
 	  lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[i]);
 	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
-				 integer_type_node, argse.expr,
-				 fold_convert(integer_type_node, lbound));
+				 TREE_TYPE (lbound), argse.expr, lbound);
 	  tmp = fold_build2_loc (input_location, MULT_EXPR,
-				 integer_type_node, extent, tmp);
+				 TREE_TYPE (tmp), extent, tmp);
 	  index = fold_build2_loc (input_location, PLUS_EXPR,
-				   integer_type_node, index, tmp);
+				   TREE_TYPE (tmp), index, tmp);
 	  if (i < ar->dimen - 1)
 	    {
 	      ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
 	      tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
-	      tmp = fold_convert (integer_type_node, tmp);
 	      extent = fold_build2_loc (input_location, MULT_EXPR,
-					integer_type_node, extent, tmp);
+					TREE_TYPE (tmp), extent, tmp);
 	    }
 	}
     }
@@ -1008,12 +1130,12 @@
       gfc_conv_expr (&argse, code->expr3);
       gfc_add_block_to_block (&se.pre, &argse.pre);
       errmsg = argse.expr;
-      errmsg_len = fold_convert (integer_type_node, argse.string_length);
+      errmsg_len = fold_convert (size_type_node, argse.string_length);
     }
   else
     {
       errmsg = null_pointer_node;
-      errmsg_len = integer_zero_node;
+      errmsg_len = build_zero_cst (size_type_node);
     }
 
   if (stat != null_pointer_node && TREE_TYPE (stat) != integer_type_node)
@@ -1022,6 +1144,7 @@
       stat = gfc_create_var (integer_type_node, "stat");
     }
 
+  index = fold_convert (size_type_node, index);
   if (op == EXEC_EVENT_POST)
     tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_event_post, 6,
 			       token, index, image_index,
@@ -1092,12 +1215,12 @@
       gfc_conv_expr (&argse, code->expr3);
       gfc_conv_string_parameter (&argse);
       errmsg = gfc_build_addr_expr (NULL, argse.expr);
-      errmsglen = argse.string_length;
+      errmsglen = fold_convert (size_type_node, argse.string_length);
     }
   else if (flag_coarray == GFC_FCOARRAY_LIB)
     {
       errmsg = null_pointer_node;
-      errmsglen = build_int_cst (integer_type_node, 0);
+      errmsglen = build_int_cst (size_type_node, 0);
     }
 
   /* Check SYNC IMAGES(imageset) for valid image index.
@@ -1107,7 +1230,7 @@
     {
       tree cond;
       if (flag_coarray != GFC_FCOARRAY_LIB)
-	cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+	cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
 				images, build_int_cst (TREE_TYPE (images), 1));
       else
 	{
@@ -1115,13 +1238,13 @@
 	  tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_num_images,
 				     2, integer_zero_node,
 				     build_int_cst (integer_type_node, -1));
-	  cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
+	  cond = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
 				  images, tmp);
-	  cond2 = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+	  cond2 = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
 				   images,
 				   build_int_cst (TREE_TYPE (images), 1));
 	  cond = fold_build2_loc (input_location, TRUTH_OR_EXPR,
-				  boolean_type_node, cond, cond2);
+				  logical_type_node, cond, cond2);
 	}
       gfc_trans_runtime_check (true, false, cond, &se.pre,
 			       &code->expr1->where, "Invalid image number "
@@ -1413,10 +1536,10 @@
       branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label2));
 
       if (code->label1->value != code->label3->value)
-        tmp = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
+        tmp = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
 			       se.expr, zero);
       else
-        tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+        tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
 			       se.expr, zero);
 
       branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_node,
@@ -1430,7 +1553,7 @@
     {
       /* if (cond <= 0) take branch1 else take branch2.  */
       branch2 = build1_v (GOTO_EXPR, gfc_get_label_decl (code->label3));
-      tmp = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+      tmp = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
 			     se.expr, zero);
       branch1 = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 				 tmp, branch1, branch2);
@@ -1533,7 +1656,6 @@
   bool need_len_assign;
   bool whole_array = true;
   gfc_ref *ref;
-  symbol_attribute attr;
 
   gcc_assert (sym->assoc);
   e = sym->assoc->target;
@@ -1579,7 +1701,8 @@
 
       desc = sym->backend_decl;
       cst_array_ctor = e->expr_type == EXPR_ARRAY
-	      && gfc_constant_array_constructor_p (e->value.constructor);
+	      && gfc_constant_array_constructor_p (e->value.constructor)
+	      && e->ts.type != BT_CHARACTER;
 
       /* If association is to an expression, evaluate it and create temporary.
 	 Otherwise, get descriptor of target for pointer assignment.  */
@@ -1600,7 +1723,7 @@
 	  && se.string_length != sym->ts.u.cl->backend_decl)
 	{
 	  gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
-			  fold_convert (gfc_charlen_type_node,
+			  fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
 					se.string_length));
 	}
 
@@ -1626,14 +1749,21 @@
       if (sym->attr.subref_array_pointer)
 	{
 	  gcc_assert (e->expr_type == EXPR_VARIABLE);
-	  tmp = e->symtree->n.sym->ts.type == BT_CLASS
-	      ? gfc_class_data_get (e->symtree->n.sym->backend_decl)
-	      : e->symtree->n.sym->backend_decl;
-	  tmp = gfc_get_element_type (TREE_TYPE (tmp));
-	  tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
+	  tmp = gfc_get_array_span (se.expr, e);
+
 	  gfc_conv_descriptor_span_set (&se.pre, desc, tmp);
 	}
 
+      if (e->expr_type == EXPR_FUNCTION
+	  && sym->ts.type == BT_DERIVED
+	  && sym->ts.u.derived
+	  && sym->ts.u.derived->attr.pdt_type)
+	{
+	  tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived, se.expr,
+					 sym->as->rank);
+	  gfc_add_expr_to_block (&se.post, tmp);
+	}
+
       /* Done, register stuff as init / cleanup code.  */
       gfc_add_init_cleanup (block, gfc_finish_block (&se.pre),
 			    gfc_finish_block (&se.post));
@@ -1771,13 +1901,12 @@
 	}
 
       if (sym->ts.type == BT_CHARACTER
-	  && sym->ts.deferred
 	  && !sym->attr.select_type_temporary
 	  && VAR_P (sym->ts.u.cl->backend_decl)
 	  && se.string_length != sym->ts.u.cl->backend_decl)
 	{
 	  gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
-			  fold_convert (gfc_charlen_type_node,
+			  fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
 					se.string_length));
 	  if (e->expr_type == EXPR_FUNCTION)
 	    {
@@ -1786,17 +1915,16 @@
 	    }
 	}
 
-      attr = gfc_expr_attr (e);
       if (sym->ts.type == BT_CHARACTER && e->ts.type == BT_CHARACTER
-	  && (attr.allocatable || attr.pointer || attr.dummy))
+	  && POINTER_TYPE_P (TREE_TYPE (se.expr)))
 	{
 	  /* These are pointer types already.  */
 	  tmp = fold_convert (TREE_TYPE (sym->backend_decl), se.expr);
 	}
       else
 	{
-          tmp = TREE_TYPE (sym->backend_decl);
-          tmp = gfc_build_addr_expr (tmp, se.expr);
+	  tmp = TREE_TYPE (sym->backend_decl);
+	  tmp = gfc_build_addr_expr (tmp, se.expr);
 	}
 
       gfc_add_modify (&se.pre, sym->backend_decl, tmp);
@@ -1810,10 +1938,65 @@
   else
     {
       gfc_expr *lhs;
+      tree res;
+      gfc_se se;
+
+      gfc_init_se (&se, NULL);
+
+      /* resolve.c converts some associate names to allocatable so that
+	 allocation can take place automatically in gfc_trans_assignment.
+	 The frontend prevents them from being either allocated,
+	 deallocated or reallocated.  */
+      if (sym->attr.allocatable)
+	{
+	  tmp = sym->backend_decl;
+	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+	    tmp = gfc_conv_descriptor_data_get (tmp);
+	  gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp),
+						    null_pointer_node));
+	}
 
       lhs = gfc_lval_expr_from_sym (sym);
-      tmp = gfc_trans_assignment (lhs, e, false, true);
-      gfc_add_init_cleanup (block, tmp, NULL_TREE);
+      res = gfc_trans_assignment (lhs, e, false, true);
+      gfc_add_expr_to_block (&se.pre, res);
+
+      tmp = sym->backend_decl;
+      if (e->expr_type == EXPR_FUNCTION
+	  && sym->ts.type == BT_DERIVED
+	  && sym->ts.u.derived
+	  && sym->ts.u.derived->attr.pdt_type)
+	{
+	  tmp = gfc_deallocate_pdt_comp (sym->ts.u.derived, tmp,
+					 0);
+	}
+      else if (e->expr_type == EXPR_FUNCTION
+	       && sym->ts.type == BT_CLASS
+	       && CLASS_DATA (sym)->ts.u.derived
+	       && CLASS_DATA (sym)->ts.u.derived->attr.pdt_type)
+	{
+	  tmp = gfc_class_data_get (tmp);
+	  tmp = gfc_deallocate_pdt_comp (CLASS_DATA (sym)->ts.u.derived,
+					 tmp, 0);
+	}
+      else if (sym->attr.allocatable)
+	{
+	  tmp = sym->backend_decl;
+
+	  if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+	    tmp = gfc_conv_descriptor_data_get (tmp);
+
+	  /* A simple call to free suffices here.  */
+	  tmp = gfc_call_free (tmp);
+
+	  /* Make sure that reallocation on assignment cannot occur.  */
+	  sym->attr.allocatable = 0;
+	}
+      else
+	tmp = NULL_TREE;
+
+      res = gfc_finish_block (&se.pre);
+      gfc_add_init_cleanup (block, res, tmp);
+      gfc_free_expr (lhs);
     }
 
   /* Set the stringlength, when needed.  */
@@ -1827,6 +2010,12 @@
 	  gcc_assert (!e->symtree->n.sym->ts.deferred);
 	  tmp = e->symtree->n.sym->ts.u.cl->backend_decl;
 	}
+      else if (e->symtree->n.sym->attr.function
+	       && e->symtree->n.sym == e->symtree->n.sym->result)
+	{
+	  tmp = gfc_get_fake_result_decl (e->symtree->n.sym, 0);
+	  tmp = gfc_class_len_get (tmp);
+	}
       else
 	tmp = gfc_class_len_get (gfc_get_symbol_decl (e->symtree->n.sym));
       gfc_get_symbol_decl (sym);
@@ -1966,13 +2155,18 @@
 
   /* Evaluate the loop condition.  */
   if (is_step_positive)
-    cond = fold_build2_loc (loc, GT_EXPR, boolean_type_node, dovar,
+    cond = fold_build2_loc (loc, GT_EXPR, logical_type_node, dovar,
 			    fold_convert (type, to));
   else
-    cond = fold_build2_loc (loc, LT_EXPR, boolean_type_node, dovar,
+    cond = fold_build2_loc (loc, LT_EXPR, logical_type_node, dovar,
 			    fold_convert (type, to));
 
   cond = gfc_evaluate_now_loc (loc, cond, &body);
+  if (code->ext.iterator->unroll && cond != error_mark_node)
+    cond
+      = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+		build_int_cst (integer_type_node, annot_expr_unroll_kind),
+		build_int_cst (integer_type_node, code->ext.iterator->unroll));
 
   /* The loop exit.  */
   tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
@@ -1988,7 +2182,7 @@
       tree boundary = is_step_positive ? TYPE_MAX_VALUE (type)
 	: TYPE_MIN_VALUE (type);
 
-      tmp = fold_build2_loc (loc, EQ_EXPR, boolean_type_node,
+      tmp = fold_build2_loc (loc, EQ_EXPR, logical_type_node,
 			     dovar, boundary);
       gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
 			       "Loop iterates infinitely");
@@ -2008,7 +2202,7 @@
   /* Check whether someone has modified the loop variable.  */
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
     {
-      tmp = fold_build2_loc (loc, NE_EXPR, boolean_type_node,
+      tmp = fold_build2_loc (loc, NE_EXPR, logical_type_node,
 			     dovar, saved_dovar);
       gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
 			       "Loop variable has been modified");
@@ -2117,7 +2311,7 @@
 
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
     {
-      tmp = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, step,
+      tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, step,
 			     build_zero_cst (type));
       gfc_trans_runtime_check (true, false, tmp, &block, &code->loc,
 			       "DO step value is zero");
@@ -2184,7 +2378,7 @@
 
       /* For a positive step, when to < from, exit, otherwise compute
          countm1 = ((unsigned)to - (unsigned)from) / (unsigned)step  */
-      tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, to, from);
+      tmp = fold_build2_loc (loc, LT_EXPR, logical_type_node, to, from);
       tmp2 = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype,
 			      fold_build2_loc (loc, MINUS_EXPR, utype,
 					       tou, fromu),
@@ -2199,7 +2393,7 @@
 
       /* For a negative step, when to > from, exit, otherwise compute
          countm1 = ((unsigned)from - (unsigned)to) / -(unsigned)step  */
-      tmp = fold_build2_loc (loc, GT_EXPR, boolean_type_node, to, from);
+      tmp = fold_build2_loc (loc, GT_EXPR, logical_type_node, to, from);
       tmp2 = fold_build2_loc (loc, TRUNC_DIV_EXPR, utype,
 			      fold_build2_loc (loc, MINUS_EXPR, utype,
 					       fromu, tou),
@@ -2212,7 +2406,7 @@
 				build1_loc (loc, GOTO_EXPR, void_type_node,
 					    exit_label), NULL_TREE));
 
-      tmp = fold_build2_loc (loc, LT_EXPR, boolean_type_node, step,
+      tmp = fold_build2_loc (loc, LT_EXPR, logical_type_node, step,
 			     build_int_cst (TREE_TYPE (step), 0));
       tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp, neg, pos);
 
@@ -2233,13 +2427,13 @@
 
       /* We need a special check for empty loops:
 	 empty = (step > 0 ? to < from : to > from);  */
-      pos_step = fold_build2_loc (loc, GT_EXPR, boolean_type_node, step,
+      pos_step = fold_build2_loc (loc, GT_EXPR, logical_type_node, step,
 				  build_zero_cst (type));
-      tmp = fold_build3_loc (loc, COND_EXPR, boolean_type_node, pos_step,
+      tmp = fold_build3_loc (loc, COND_EXPR, logical_type_node, pos_step,
 			     fold_build2_loc (loc, LT_EXPR,
-					      boolean_type_node, to, from),
+					      logical_type_node, to, from),
 			     fold_build2_loc (loc, GT_EXPR,
-					      boolean_type_node, to, from));
+					      logical_type_node, to, from));
       /* If the loop is empty, go directly to the exit label.  */
       tmp = fold_build3_loc (loc, COND_EXPR, void_type_node, tmp,
 			 build1_v (GOTO_EXPR, exit_label),
@@ -2264,7 +2458,7 @@
   /* Check whether someone has modified the loop variable.  */
   if (gfc_option.rtcheck & GFC_RTCHECK_DO)
     {
-      tmp = fold_build2_loc (loc, NE_EXPR, boolean_type_node, dovar,
+      tmp = fold_build2_loc (loc, NE_EXPR, logical_type_node, dovar,
 			     saved_dovar);
       gfc_trans_runtime_check (true, false, tmp, &body, &code->loc,
 			       "Loop variable has been modified");
@@ -2297,8 +2491,13 @@
   gfc_add_modify_loc (loc, &body, countm1, tmp);
 
   /* End with the loop condition.  Loop until countm1t == 0.  */
-  cond = fold_build2_loc (loc, EQ_EXPR, boolean_type_node, countm1t,
+  cond = fold_build2_loc (loc, EQ_EXPR, logical_type_node, countm1t,
 			  build_int_cst (utype, 0));
+  if (code->ext.iterator->unroll && cond != error_mark_node)
+    cond
+      = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+		build_int_cst (integer_type_node, annot_expr_unroll_kind),
+		build_int_cst (integer_type_node, code->ext.iterator->unroll));
   tmp = fold_build1_loc (loc, GOTO_EXPR, void_type_node, exit_label);
   tmp = fold_build3_loc (loc, COND_EXPR, void_type_node,
 			 cond, tmp, build_empty_stmt (loc));
@@ -2660,8 +2859,7 @@
     }
 
   tmp = gfc_finish_block (&body);
-  tmp = fold_build3_loc (input_location, SWITCH_EXPR, NULL_TREE,
-			 se.expr, tmp, NULL_TREE);
+  tmp = fold_build2_loc (input_location, SWITCH_EXPR, NULL_TREE, se.expr, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   tmp = build1_v (LABEL_EXPR, end_label);
@@ -2823,7 +3021,7 @@
     {
       for (d = cp; d; d = d->right)
 	{
-	  int i;
+	  gfc_charlen_t i;
 	  if (d->low)
 	    {
 	      gcc_assert (d->low->expr_type == EXPR_CONSTANT
@@ -2946,8 +3144,8 @@
 	  gfc_add_block_to_block (&block, &expr1se.post);
 
 	  tmp = gfc_finish_block (&body);
-	  tmp = fold_build3_loc (input_location, SWITCH_EXPR, NULL_TREE,
-				 case_num, tmp, NULL_TREE);
+	  tmp = fold_build2_loc (input_location, SWITCH_EXPR, NULL_TREE,
+				 case_num, tmp);
 	  gfc_add_expr_to_block (&block, tmp);
 
 	  tmp = build1_v (LABEL_EXPR, end_label);
@@ -3028,7 +3226,7 @@
       if (d->low == NULL)
         {
           CONSTRUCTOR_APPEND_ELT (node, ss_string1[k], null_pointer_node);
-          CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], integer_zero_node);
+          CONSTRUCTOR_APPEND_ELT (node, ss_string1_len[k], build_zero_cst (gfc_charlen_type_node));
         }
       else
         {
@@ -3041,7 +3239,7 @@
       if (d->high == NULL)
         {
           CONSTRUCTOR_APPEND_ELT (node, ss_string2[k], null_pointer_node);
-          CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], integer_zero_node);
+          CONSTRUCTOR_APPEND_ELT (node, ss_string2_len[k], build_zero_cst (gfc_charlen_type_node));
         }
       else
         {
@@ -3093,8 +3291,8 @@
   gfc_add_block_to_block (&block, &expr1se.post);
 
   tmp = gfc_finish_block (&body);
-  tmp = fold_build3_loc (input_location, SWITCH_EXPR, NULL_TREE,
-			 case_num, tmp, NULL_TREE);
+  tmp = fold_build2_loc (input_location, SWITCH_EXPR, NULL_TREE,
+			 case_num, tmp);
   gfc_add_expr_to_block (&block, tmp);
 
   tmp = build1_v (LABEL_EXPR, end_label);
@@ -3450,12 +3648,16 @@
       gfc_init_block (&block);
 
       /* The exit condition.  */
-      cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node,
+      cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
 			      count, build_int_cst (TREE_TYPE (count), 0));
+
+      /* PR 83064 means that we cannot use annot_expr_parallel_kind until
+       the autoparallelizer can hande this.  */
       if (forall_tmp->do_concurrent)
-	cond = build2 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
+	cond = build3 (ANNOTATE_EXPR, TREE_TYPE (cond), cond,
 		       build_int_cst (integer_type_node,
-				      annot_expr_ivdep_kind));
+				      annot_expr_ivdep_kind),
+		       integer_zero_node);
 
       tmp = build1_v (GOTO_EXPR, exit_label);
       tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
@@ -5128,7 +5330,7 @@
 					  &inner_size_body, block);
 
       /* Check whether the size is negative.  */
-      cond = fold_build2_loc (input_location, LE_EXPR, boolean_type_node, size,
+      cond = fold_build2_loc (input_location, LE_EXPR, logical_type_node, size,
 			      gfc_index_zero_node);
       size = fold_build3_loc (input_location, COND_EXPR, gfc_array_index_type,
 			      cond, gfc_index_zero_node, size);
@@ -5592,9 +5794,11 @@
   enum { E3_UNSET = 0, E3_SOURCE, E3_MOLD, E3_DESC } e3_is;
   stmtblock_t block;
   stmtblock_t post;
+  stmtblock_t final_block;
   tree nelems;
   bool upoly_expr, tmp_expr3_len_flag = false, al_len_needs_set, is_coarray;
   bool needs_caf_sync, caf_refs_comp;
+  bool e3_has_nodescriptor = false;
   gfc_symtree *newsym = NULL;
   symbol_attribute caf_attr;
   gfc_actual_arglist *param_list;
@@ -5610,6 +5814,7 @@
 
   gfc_init_block (&block);
   gfc_init_block (&post);
+  gfc_init_block (&final_block);
 
   /* STAT= (and maybe ERRMSG=) is present.  */
   if (code->expr1)
@@ -5651,6 +5856,11 @@
 
       is_coarray = gfc_is_coarray (code->expr3);
 
+      if (code->expr3->expr_type == EXPR_FUNCTION && !code->expr3->mold
+	  && (gfc_is_class_array_function (code->expr3)
+	      || gfc_is_alloc_class_scalar_function (code->expr3)))
+	code->expr3->must_finalize = 1;
+
       /* Figure whether we need the vtab from expr3.  */
       for (al = code->ext.alloc.list; !vtab_needed && al != NULL;
 	   al = al->next)
@@ -5723,7 +5933,10 @@
 	  temp_obj_created = temp_var_needed = !VAR_P (se.expr);
 	}
       gfc_add_block_to_block (&block, &se.pre);
-      gfc_add_block_to_block (&post, &se.post);
+      if (code->expr3->must_finalize)
+	gfc_add_block_to_block (&final_block, &se.post);
+      else
+	gfc_add_block_to_block (&post, &se.post);
 
       /* Special case when string in expr3 is zero.  */
       if (code->expr3->ts.type == BT_CHARACTER
@@ -5731,7 +5944,7 @@
 	{
 	  gfc_init_se (&se, NULL);
 	  temp_var_needed = false;
-	  expr3_len = integer_zero_node;
+	  expr3_len = build_zero_cst (gfc_charlen_type_node);
 	  e3_is = E3_MOLD;
 	}
       /* Prevent aliasing, i.e., se.expr may be already a
@@ -5795,7 +6008,8 @@
       if ((code->expr3->ts.type == BT_DERIVED
 	   || code->expr3->ts.type == BT_CLASS)
 	  && (code->expr3->expr_type != EXPR_VARIABLE || temp_obj_created)
-	  && code->expr3->ts.u.derived->attr.alloc_comp)
+	  && code->expr3->ts.u.derived->attr.alloc_comp
+	  && !code->expr3->must_finalize)
 	{
 	  tmp = gfc_deallocate_alloc_comp (code->expr3->ts.u.derived,
 					   expr3, code->expr3->rank);
@@ -5913,10 +6127,9 @@
       if (code->ext.alloc.ts.type != BT_CHARACTER)
 	expr3_esize = TYPE_SIZE_UNIT (
 	      gfc_typenode_for_spec (&code->ext.alloc.ts));
-      else
+      else if (code->ext.alloc.ts.u.cl->length != NULL)
 	{
 	  gfc_expr *sz;
-	  gcc_assert (code->ext.alloc.ts.u.cl->length != NULL);
 	  sz = gfc_copy_expr (code->ext.alloc.ts.u.cl->length);
 	  gfc_init_se (&se_sz, NULL);
 	  gfc_conv_expr (&se_sz, sz);
@@ -5930,6 +6143,8 @@
 					 tmp, se_sz.expr);
 	  expr3_esize = gfc_evaluate_now (expr3_esize, &block);
 	}
+      else
+	expr3_esize = NULL_TREE;
     }
 
   /* The routine gfc_trans_assignment () already implements all
@@ -6019,6 +6234,17 @@
 	}
       else
 	e3rhs = gfc_copy_expr (code->expr3);
+
+      // We need to propagate the bounds of the expr3 for source=/mold=;
+      // however, for nondescriptor arrays, we use internally a lower bound
+      // of zero instead of one, which needs to be corrected for the allocate obj
+      if (e3_is == E3_DESC)
+	{
+	  symbol_attribute attr = gfc_expr_attr (code->expr3);
+	  if (code->expr3->expr_type == EXPR_ARRAY ||
+	      (!attr.allocatable && !attr.pointer))
+	    e3_has_nodescriptor = true;
+	}
     }
 
   /* Loop over all objects to allocate.  */
@@ -6102,12 +6328,12 @@
 	}
       else
 	tmp = expr3_esize;
+
       if (!gfc_array_allocate (&se, expr, stat, errmsg, errlen,
 			       label_finish, tmp, &nelems,
 			       e3rhs ? e3rhs : code->expr3,
 			       e3_is == E3_DESC ? expr3 : NULL_TREE,
-			       code->expr3 != NULL && e3_is == E3_DESC
-			       && code->expr3->expr_type == EXPR_ARRAY))
+			       e3_has_nodescriptor))
 	{
 	  /* A scalar or derived type.  First compute the size to
 	     allocate.
@@ -6134,8 +6360,9 @@
 		     polymorphic and stores a _len dependent object,
 		     e.g., a string.  */
 		  memsz = fold_build2_loc (input_location, GT_EXPR,
-					   boolean_type_node, expr3_len,
-					   integer_zero_node);
+					   logical_type_node, expr3_len,
+					   build_zero_cst
+					   (TREE_TYPE (expr3_len)));
 		  memsz = fold_build3_loc (input_location, COND_EXPR,
 					 TREE_TYPE (expr3_esize),
 					 memsz, tmp, expr3_esize);
@@ -6267,7 +6494,7 @@
 	{
 	  tmp = build1_v (GOTO_EXPR, label_errmsg);
 	  parm = fold_build2_loc (input_location, NE_EXPR,
-				  boolean_type_node, stat,
+				  logical_type_node, stat,
 				  build_int_cst (TREE_TYPE (stat), 0));
 	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 				 gfc_unlikely (parm, PRED_FORTRAN_FAIL_ALLOC),
@@ -6504,7 +6731,7 @@
 		gfc_build_addr_expr (pchar_type_node,
 			gfc_build_localized_cstring_const (msg)));
 
-      slen = build_int_cst (gfc_charlen_type_node, ((int) strlen (msg)));
+      slen = build_int_cst (gfc_charlen_type_node, strlen (msg));
       dlen = gfc_get_expr_charlen (code->expr2);
       slen = fold_build2_loc (input_location, MIN_EXPR,
 			      TREE_TYPE (slen), dlen, slen);
@@ -6515,7 +6742,7 @@
 			     gfc_default_character_kind);
       dlen = gfc_finish_block (&errmsg_block);
 
-      tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+      tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
 			     stat, build_int_cst (TREE_TYPE (stat), 0));
 
       tmp = build3_v (COND_EXPR, tmp,
@@ -6550,6 +6777,8 @@
 
   gfc_add_block_to_block (&block, &se.post);
   gfc_add_block_to_block (&block, &post);
+  if (code->expr3 && code->expr3->must_finalize)
+    gfc_add_block_to_block (&block, &final_block);
 
   return gfc_finish_block (&block);
 }
@@ -6768,7 +6997,7 @@
 	{
           tree cond;
 
-	  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat,
+	  cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat,
 				  build_int_cst (TREE_TYPE (stat), 0));
 	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 				 gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC),
@@ -6801,14 +7030,14 @@
       gfc_add_modify (&errmsg_block, errmsg_str,
 		gfc_build_addr_expr (pchar_type_node,
                         gfc_build_localized_cstring_const (msg)));
-      slen = build_int_cst (gfc_charlen_type_node, ((int) strlen (msg)));
+      slen = build_int_cst (gfc_charlen_type_node, strlen (msg));
       dlen = gfc_get_expr_charlen (code->expr2);
 
       gfc_trans_string_copy (&errmsg_block, dlen, errmsg, code->expr2->ts.kind,
 			     slen, errmsg_str, gfc_default_character_kind);
       tmp = gfc_finish_block (&errmsg_block);
 
-      cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node, stat,
+      cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node, stat,
 			     build_int_cst (TREE_TYPE (stat), 0));
       tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 			     gfc_unlikely (cond, PRED_FORTRAN_FAIL_ALLOC), tmp,