Make sure types in assignments are compatible.

2004-06-29  Steven Bosscher  <stevenb@suse.de>

	Make sure types in assignments are compatible.  Mostly mechanical.
	* trans-const.h (gfc_index_one_node): New define.
	* trans-array.c (gfc_trans_allocate_array_storage,
	gfc_trans_allocate_temp_array, gfc_trans_array_constructor_subarray,
	gfc_trans_array_constructor_value, gfc_trans_array_constructor,
	gfc_conv_array_ubound, gfc_conv_array_ref,
	gfc_trans_scalarized_loop_end, gfc_conv_section_startstride,
	gfc_conv_ss_startstride, gfc_conv_loop_setup, gfc_array_init_size,
	gfc_trans_array_bounds, gfc_trans_dummy_array_bias,
	gfc_conv_expr_descriptor, gfc_trans_deferred_array): Use the correct
	types in assignments, conversions and conditionals for expressions.
	* trans-expr.c (gfc_conv_expr_present, gfc_conv_substring,
	gfc_conv_unary_op, gfc_conv_cst_int_power, gfc_conv_string_tmp,
	gfc_conv_function_call, gfc_trans_pointer_assignment,
	gfc_trans_scalar_assign): Likewise.
	* trans-intrinsic.c (build_fixbound_expr, gfc_conv_intrinsic_bound,
	gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count,
	gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_btest,
	gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ishft,
	gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_strcmp,
	gfc_conv_allocated, gfc_conv_associated,
	gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_trim): Likewise.
	* trans-io.c (set_string): Likewise.
	* trans-stmt.c (gfc_trans_do, gfc_trans_forall_loop,
	gfc_do_allocate, generate_loop_for_temp_to_lhs,
	generate_loop_for_rhs_to_temp, compute_inner_temp_size,
	compute_overall_iter_number, gfc_trans_assign_need_temp,
	gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
	gfc_evaluate_where_mask, gfc_trans_where_assign,
	gfc_trans_where_2): Likewise.
	* trans-types.c (gfc_get_character_type, gfc_build_array_type,
	gfc_get_nodesc_array_type, gfc_get_array_type_bounds): Likewise.

	* trans.c (gfc_add_modify_expr): Add sanity check that types
	for the lhs and rhs are the same for scalar assignments.

From-SVN: r83877

gcc/fortran/ChangeLog

+2004-06-29  Steven Bosscher  <stevenb@suse.de>
+
+	Make sure types in assignments are compatible.  Mostly mechanical.
+	* trans-const.h (gfc_index_one_node): New define.
+	* trans-array.c (gfc_trans_allocate_array_storage,
+	gfc_trans_allocate_temp_array, gfc_trans_array_constructor_subarray,
+	gfc_trans_array_constructor_value, gfc_trans_array_constructor,
+	gfc_conv_array_ubound, gfc_conv_array_ref,
+	gfc_trans_scalarized_loop_end, gfc_conv_section_startstride,
+	gfc_conv_ss_startstride, gfc_conv_loop_setup, gfc_array_init_size,
+	gfc_trans_array_bounds, gfc_trans_dummy_array_bias,
+	gfc_conv_expr_descriptor, gfc_trans_deferred_array): Use the correct
+	types in assignments, conversions and conditionals for expressions.
+	* trans-expr.c (gfc_conv_expr_present, gfc_conv_substring,
+	gfc_conv_unary_op, gfc_conv_cst_int_power, gfc_conv_string_tmp,
+	gfc_conv_function_call, gfc_trans_pointer_assignment,
+	gfc_trans_scalar_assign): Likewise.
+	* trans-intrinsic.c (build_fixbound_expr, gfc_conv_intrinsic_bound,
+	gfc_conv_intrinsic_anyall, gfc_conv_intrinsic_count,
+	gfc_conv_intrinsic_minmaxloc, gfc_conv_intrinsic_btest,
+	gfc_conv_intrinsic_singlebitop, gfc_conv_intrinsic_ishft,
+	gfc_conv_intrinsic_ishftc, gfc_conv_intrinsic_strcmp,
+	gfc_conv_allocated, gfc_conv_associated,
+	gfc_conv_intrinsic_rrspacing, gfc_conv_intrinsic_trim): Likewise.
+	* trans-io.c (set_string): Likewise.
+	* trans-stmt.c (gfc_trans_do, gfc_trans_forall_loop,
+	gfc_do_allocate, generate_loop_for_temp_to_lhs,
+	generate_loop_for_rhs_to_temp, compute_inner_temp_size,
+	compute_overall_iter_number, gfc_trans_assign_need_temp,
+	gfc_trans_pointer_assign_need_temp, gfc_trans_forall_1,
+	gfc_evaluate_where_mask, gfc_trans_where_assign,
+	gfc_trans_where_2): Likewise.
+	* trans-types.c (gfc_get_character_type, gfc_build_array_type,
+	gfc_get_nodesc_array_type, gfc_get_array_type_bounds): Likewise.
+
+	* trans.c (gfc_add_modify_expr): Add sanity check that types
+	for the lhs and rhs are the same for scalar assignments.
+
 2004-06-29  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	* dump-parse-tree.c (show_common): New function.

gcc/fortran/trans-array.c

@@ -443,7 +443,7 @@ gfc_trans_allocate_array_storage (gfc_loopinfo * loop, gfc_ss_info * info,
       /* Make a temporary variable to hold the data.  */
       tmp = fold (build (MINUS_EXPR, TREE_TYPE (nelem), nelem,
 			 integer_one_node));
-      tmp = build_range_type (gfc_array_index_type, integer_zero_node, tmp);
+      tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
       tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)), tmp);
       tmp = gfc_create_var (tmp, "A");
       tmp = gfc_build_addr_expr (TREE_TYPE (data), tmp);
@@ -515,12 +515,12 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info,
 	{
 	  loop->to[n] = fold (build (MINUS_EXPR, gfc_array_index_type,
 				     loop->to[n], loop->from[n]));
-	  loop->from[n] = integer_zero_node;
+	  loop->from[n] = gfc_index_zero_node;
 	}
 
-      info->delta[dim] = integer_zero_node;
-      info->start[dim] = integer_zero_node;
-      info->stride[dim] = integer_one_node;
+      info->delta[dim] = gfc_index_zero_node;
+      info->start[dim] = gfc_index_zero_node;
+      info->stride[dim] = gfc_index_one_node;
       info->dim[dim] = dim;
     }
 
@@ -531,14 +531,16 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info,
   GFC_DECL_PACKED_ARRAY (desc) = 1;
 
   info->descriptor = desc;
-  size = integer_one_node;
+  size = gfc_index_one_node;
 
   /* Fill in the array dtype.  */
   tmp = gfc_conv_descriptor_dtype (desc);
   gfc_add_modify_expr (&loop->pre, tmp,
 		       GFC_TYPE_ARRAY_DTYPE (TREE_TYPE (desc)));
 
-  /* Fill in the bounds and stride.  This is a packed array, so:
+  /*
+     Fill in the bounds and stride.  This is a packed array, so:
+
      size = 1;
      for (n = 0; n < rank; n++)
        {
@@ -546,7 +548,9 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info,
 	 delta = ubound[n] + 1 - lbound[n];
          size = size * delta;
        }
-     size = size * sizeof(element);  */
+     size = size * sizeof(element);
+  */
+
   for (n = 0; n < info->dimen; n++)
     {
       /* Store the stride and bound components in the descriptor.  */
@@ -554,13 +558,13 @@ gfc_trans_allocate_temp_array (gfc_loopinfo * loop, gfc_ss_info * info,
       gfc_add_modify_expr (&loop->pre, tmp, size);
 
       tmp = gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]);
-      gfc_add_modify_expr (&loop->pre, tmp, integer_zero_node);
+      gfc_add_modify_expr (&loop->pre, tmp, gfc_index_zero_node);
 
       tmp = gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]);
       gfc_add_modify_expr (&loop->pre, tmp, loop->to[n]);
 
       tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
-			 loop->to[n], integer_one_node));
+			 loop->to[n], gfc_index_one_node));
 
       size = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp));
       size = gfc_evaluate_now (size, &loop->pre);
@@ -645,7 +649,7 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock,
   gfc_add_modify_expr (&body, tmp, se.expr);
 
   /* Increment the offset.  */
-  tmp = build (PLUS_EXPR, gfc_array_index_type, *poffset, integer_one_node);
+  tmp = build (PLUS_EXPR, gfc_array_index_type, *poffset, gfc_index_one_node);
   gfc_add_modify_expr (&body, *poffset, tmp);
 
   /* Finish the loop.  */
@@ -716,11 +720,12 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
 
 	      ref = gfc_build_indirect_ref (pointer);
 	      ref = gfc_build_array_ref (ref, *poffset);
-	      gfc_add_modify_expr (&body, ref, se.expr);
+	      gfc_add_modify_expr (&body, ref,
+				   fold_convert (TREE_TYPE (ref), se.expr));
 	      gfc_add_block_to_block (&body, &se.post);
 
 	      *poffset = fold (build (PLUS_EXPR, gfc_array_index_type,
-				      *poffset, integer_one_node));
+				      *poffset, gfc_index_one_node));
 	    }
 	  else
 	    {
@@ -746,7 +751,7 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
 	      bound = build_int_2 (n - 1, 0);
               /* Create an array type to hold them.  */
 	      tmptype = build_range_type (gfc_array_index_type,
-					  integer_zero_node, bound);
+					  gfc_index_zero_node, bound);
 	      tmptype = build_array_type (type, tmptype);
 
 	      init = build1 (CONSTRUCTOR, tmptype, nreverse (list));
@@ -942,7 +947,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
     gfc_trans_allocate_temp_array (loop, &ss->data.info, type, NULL_TREE);
 
   desc = ss->data.info.descriptor;
-  offset = integer_zero_node;
+  offset = gfc_index_zero_node;
   offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
   TREE_USED (offsetvar) = 0;
   gfc_trans_array_constructor_value (&loop->pre, type,
@@ -1214,7 +1219,7 @@ gfc_conv_array_ubound (tree descriptor, int dim)
   /* This should only ever happen when passing an assumed shape array
      as an actual parameter.  The value will never be used.  */
   if (GFC_ARRAY_TYPE_P (TREE_TYPE (descriptor)))
-    return integer_zero_node;
+    return gfc_index_zero_node;
 
   tmp = gfc_conv_descriptor_ubound (descriptor, gfc_rank_cst[dim]);
   return tmp;
@@ -1466,9 +1471,9 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
       return;
     }
 
-  index = integer_zero_node;
+  index = gfc_index_zero_node;
 
-  fault = integer_zero_node;
+  fault = gfc_index_zero_node;
 
   /* Calculate the offsets from all the dimensions.  */
   for (n = 0; n < ar->dimen; n++)
@@ -1687,7 +1692,7 @@ gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n,
 
   /* Increment the loopvar.  */
   tmp = build (PLUS_EXPR, gfc_array_index_type,
-	       loop->loopvar[n], integer_one_node);
+	       loop->loopvar[n], gfc_index_one_node);
   gfc_add_modify_expr (&block, loop->loopvar[n], tmp);
 
   /* Build the loop.  */
@@ -1885,7 +1890,7 @@ gfc_conv_section_startstride (gfc_loopinfo * loop, gfc_ss * ss, int n)
 
   /* Calculate the stride.  */
   if (stride == NULL)
-    info->stride[n] = integer_one_node;
+    info->stride[n] = gfc_index_one_node;
   else
     {
       gfc_init_se (&se, NULL);
@@ -1948,8 +1953,8 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	case GFC_SS_FUNCTION:
 	  for (n = 0; n < ss->data.info.dimen; n++)
 	    {
-	      ss->data.info.start[n] = integer_zero_node;
-	      ss->data.info.stride[n] = integer_one_node;
+	      ss->data.info.start[n] = gfc_index_zero_node;
+	      ss->data.info.stride[n] = gfc_index_one_node;
 	    }
 	  break;
 
@@ -2322,7 +2327,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
 
       /* Transform everything so we have a simple incrementing variable.  */
       if (integer_onep (info->stride[n]))
-	info->delta[n] = integer_zero_node;
+	info->delta[n] = gfc_index_zero_node;
       else
 	{
 	  /* Set the delta for this section.  */
@@ -2337,7 +2342,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
 			     info->stride[n]));
 	  loop->to[n] = gfc_evaluate_now (tmp, &loop->pre);
 	  /* Make the loop variable start at 0.  */
-	  loop->from[n] = integer_zero_node;
+	  loop->from[n] = gfc_index_zero_node;
 	}
     }
 
@@ -2435,8 +2440,8 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
 
   type = TREE_TYPE (descriptor);
 
-  stride = integer_one_node;
-  offset = integer_zero_node;
+  stride = gfc_index_one_node;
+  offset = gfc_index_zero_node;
 
   /* Set the dtype.  */
   tmp = gfc_conv_descriptor_dtype (descriptor);
@@ -2454,7 +2459,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
       /* Set lower bound.  */
       gfc_init_se (&se, NULL);
       if (lower == NULL)
-	se.expr = integer_one_node;
+	se.expr = gfc_index_one_node;
       else
 	{
 	  assert (lower[n]);
@@ -2465,7 +2470,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
             }
           else
             {
-              se.expr = integer_one_node;
+              se.expr = gfc_index_one_node;
               ubound = lower[n];
             }
 	}
@@ -2478,7 +2483,7 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset,
 
       /* Start the calculation for the size of this dimension.  */
       size = build (MINUS_EXPR, gfc_array_index_type,
-		    integer_one_node, se.expr);
+		    gfc_index_one_node, se.expr);
 
       /* Set upper bound.  */
       gfc_init_se (&se, NULL);
@@ -2754,8 +2759,8 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
 
   as = sym->as;
 
-  size = integer_one_node;
-  offset = integer_zero_node;
+  size = gfc_index_one_node;
+  offset = gfc_index_zero_node;
   for (dim = 0; dim < as->rank; dim++)
     {
       /* Evaluate non-constant array bound expressions.  */
@@ -2789,7 +2794,7 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset,
         {
           /* Calculate stride = size * (ubound + 1 - lbound).  */
           tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
-                             integer_one_node, lbound));
+                             gfc_index_one_node, lbound));
           tmp = fold (build (PLUS_EXPR, gfc_array_index_type, ubound, tmp));
           tmp = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp));
           if (stride)
@@ -3062,7 +3067,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
 
       tmp = build (EQ_EXPR, boolean_type_node, stride, integer_zero_node);
       tmp = build (COND_EXPR, gfc_array_index_type, tmp,
-                   integer_one_node, stride);
+                   gfc_index_one_node, stride);
       stride = GFC_TYPE_ARRAY_STRIDE (type, 0);
       gfc_add_modify_expr (&block, stride, tmp);
 
@@ -3077,7 +3082,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
       tmp = gfc_chainon_list (NULL_TREE, tmp);
       stmt_unpacked = gfc_build_function_call (gfor_fndecl_in_pack, tmp);
 
-      stride = integer_one_node;
+      stride = gfc_index_one_node;
     }
 
   /* This is for the case where the array data is used directly without
@@ -3096,10 +3101,10 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
     }
   else
     tmp = stmt_packed != NULL_TREE ? stmt_packed : stmt_unpacked;
-  gfc_add_modify_expr (&block, tmpdesc, tmp);
+  gfc_add_modify_expr (&block, tmpdesc, fold_convert (type, tmp));
 
-  offset = integer_zero_node;
-  size = integer_one_node;
+  offset = gfc_index_zero_node;
+  size = gfc_index_one_node;
 
   /* Evaluate the bounds of the array.  */
   for (n = 0; n < sym->as->rank; n++)
@@ -3185,7 +3190,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
                 {
                   /* Calculate stride = size * (ubound + 1 - lbound).  */
                   tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
-                                     integer_one_node, lbound));
+                                     gfc_index_one_node, lbound));
                   tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
                                      ubound, tmp));
                   size = fold (build (MULT_EXPR, gfc_array_index_type,
@@ -3266,8 +3271,8 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
 }
 
 
-/* Convert an array for passing as an actual parameter.  Expressions
-   and vector subscripts are evaluated and stored in a teporary, which is then
+/* Convert an array for passing as an actual parameter.  Expressions and
+   vector subscripts are evaluated and stored in a temporary, which is then
    passed.  For whole arrays the descriptor is passed.  For array sections
    a modified copy of the descriptor is passed, but using the original data.
    Also used for array pointer assignments by setting se->direct_byref.  */
@@ -3435,7 +3440,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       /* Set the first stride component to zero to indicate a temporary.  */
       desc = loop.temp_ss->data.info.descriptor;
       tmp = gfc_conv_descriptor_stride (desc, gfc_rank_cst[0]);
-      gfc_add_modify_expr (&loop.pre, tmp, integer_zero_node);
+      gfc_add_modify_expr (&loop.pre, tmp, gfc_index_zero_node);
 
       assert (is_gimple_lvalue (desc));
       se->expr = gfc_build_addr_expr (NULL, desc);
@@ -3473,7 +3478,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	  parm = gfc_create_var (parmtype, "parm");
 	}
 
-      offset = integer_zero_node;
+      offset = gfc_index_zero_node;
       dim = 0;
 
       /* The following can be somewhat confusing.  We have two
@@ -3490,7 +3495,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       gfc_add_modify_expr (&loop.pre, tmp, GFC_TYPE_ARRAY_DTYPE (parmtype));
 
       if (se->direct_byref)
-	base = integer_zero_node;
+	base = gfc_index_zero_node;
       else
 	base = NULL_TREE;
 
@@ -3536,10 +3541,10 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
           if (!integer_onep (from))
 	    {
 	      /* Make sure the new section starts at 1.  */
-	      tmp = fold (build (MINUS_EXPR, TREE_TYPE (from),
-				 integer_one_node, from));
-	      to = fold (build (PLUS_EXPR, TREE_TYPE (to), to, tmp));
-	      from = integer_one_node;
+	      tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
+				 gfc_index_one_node, from));
+	      to = fold (build (PLUS_EXPR, gfc_array_index_type, to, tmp));
+	      from = gfc_index_one_node;
 	    }
 	  tmp = gfc_conv_descriptor_lbound (parm, gfc_rank_cst[dim]);
 	  gfc_add_modify_expr (&loop.pre, tmp, from);
@@ -3573,7 +3578,8 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       offset = gfc_build_addr_expr (gfc_array_dataptr_type (desc), tmp);
 
       tmp = gfc_conv_descriptor_data (parm);
-      gfc_add_modify_expr (&loop.pre, tmp, offset);
+      gfc_add_modify_expr (&loop.pre, tmp,
+			   fold_convert (TREE_TYPE (tmp), offset));
 
       if (se->direct_byref)
 	{
@@ -3737,7 +3743,8 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
 
   /* NULLIFY the data pointer.  */
   tmp = gfc_conv_descriptor_data (descriptor);
-  gfc_add_modify_expr (&fnblock, tmp, integer_zero_node);
+  gfc_add_modify_expr (&fnblock, tmp,
+		       convert (TREE_TYPE (tmp), integer_zero_node));
 
   gfc_add_expr_to_block (&fnblock, body);
 

gcc/fortran/trans-const.h

@@ -56,4 +56,6 @@ extern GTY(()) tree gfc_strconst_wrong_return;
 
 /* Integer constants 0..GFC_MAX_DIMENSIONS.  */
 extern GTY(()) tree gfc_rank_cst[GFC_MAX_DIMENSIONS + 1];
+
 #define gfc_index_zero_node gfc_rank_cst[0]
+#define gfc_index_one_node gfc_rank_cst[1]

gcc/fortran/trans-expr.c

@@ -135,7 +135,8 @@ gfc_conv_expr_present (gfc_symbol * sym)
              || GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
       decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
     }
-  return build (NE_EXPR, boolean_type_node, decl, null_pointer_node);
+  return build (NE_EXPR, boolean_type_node, decl,
+		fold_convert (TREE_TYPE (decl), null_pointer_node));
 }
 
 
@@ -174,9 +175,7 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind)
   gfc_add_block_to_block (&se->pre, &start.pre);
 
   if (integer_onep (start.expr))
-    {
     gfc_conv_string_parameter (se);
-    }
   else
     {
       /* Change the start of the string.  */
@@ -198,7 +197,9 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind)
       gfc_add_block_to_block (&se->pre, &end.pre);
     }
   tmp =
-    build (MINUS_EXPR, gfc_strlen_type_node, integer_one_node, start.expr);
+    build (MINUS_EXPR, gfc_strlen_type_node,
+	   fold_convert (gfc_strlen_type_node, integer_one_node),
+	   start.expr);
   tmp = build (PLUS_EXPR, gfc_strlen_type_node, end.expr, tmp);
   se->string_length = fold (tmp);
 }
@@ -376,7 +377,8 @@ gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr)
      We must convert it to a compare to 0 (e.g. EQ_EXPR (op1, 0)).
      All other unary operators have an equivalent GIMPLE unary operator  */
   if (code == TRUTH_NOT_EXPR)
-    se->expr = build (EQ_EXPR, type, operand.expr, integer_zero_node);
+    se->expr = build (EQ_EXPR, type, operand.expr,
+		      convert (type, integer_zero_node));
   else
     se->expr = build1 (code, type, operand.expr);
 
@@ -502,24 +504,27 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
   if ((sgn == -1) && (TREE_CODE (type) == INTEGER_TYPE))
     {
       tmp = build (EQ_EXPR, boolean_type_node, lhs,
-			integer_minus_one_node);
+		   fold_convert (TREE_TYPE (lhs), integer_minus_one_node));
       cond = build (EQ_EXPR, boolean_type_node, lhs,
-			integer_one_node);
+		    convert (TREE_TYPE (lhs), integer_one_node));
 
       /* If rhs is an even,
 	 result = (lhs == 1 || lhs == -1) ? 1 : 0.  */
       if ((n & 1) == 0)
         {
 	  tmp = build (TRUTH_OR_EXPR, boolean_type_node, tmp, cond);
-	  se->expr = build (COND_EXPR, type, tmp, integer_one_node, 
-			integer_zero_node);
+	  se->expr = build (COND_EXPR, type, tmp,
+			    convert (type, integer_one_node),
+			    convert (type, integer_zero_node));
 	  return 1;
 	}
       /* If rhs is an odd,
 	 result = (lhs == 1) ? 1 : (lhs == -1) ? -1 : 0.  */
-      tmp = build (COND_EXPR, type, tmp, integer_minus_one_node,
-			integer_zero_node);
-      se->expr = build (COND_EXPR, type, cond, integer_one_node,
+      tmp = build (COND_EXPR, type, tmp,
+		   convert (type, integer_minus_one_node),
+		   convert (type, integer_zero_node));
+      se->expr = build (COND_EXPR, type, cond,
+			convert (type, integer_one_node),
 			tmp);
       return 1;
     }
@@ -675,11 +680,16 @@ gfc_conv_string_tmp (gfc_se * se, tree type, tree len)
   tree tmp;
   tree args;
 
+  if (TREE_TYPE (len) != gfc_strlen_type_node)
+    abort ();
+
   if (gfc_can_put_var_on_stack (len))
     {
       /* Create a temporary variable to hold the result.  */
-      tmp = fold (build (MINUS_EXPR, TREE_TYPE (len), len, integer_one_node));
-      tmp = build_range_type (gfc_array_index_type, integer_zero_node, tmp);
+      tmp = fold (build (MINUS_EXPR, gfc_strlen_type_node, len,
+			 convert (gfc_strlen_type_node,
+				  integer_one_node)));
+      tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
       tmp = build_array_type (gfc_character1_type_node, tmp);
       var = gfc_create_var (tmp, "str");
       var = gfc_build_addr_expr (type, var);
@@ -1030,7 +1040,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	  /* Zero the first stride to indicate a temporary.  */
 	  tmp =
 	    gfc_conv_descriptor_stride (info->descriptor, gfc_rank_cst[0]);
-	  gfc_add_modify_expr (&se->pre, tmp, integer_zero_node);
+	  gfc_add_modify_expr (&se->pre, tmp,
+			       convert (TREE_TYPE (tmp), integer_zero_node));
 	  /* Pass the temporary as the first argument.  */
 	  tmp = info->descriptor;
 	  tmp = gfc_build_addr_expr (NULL, tmp);
@@ -1080,8 +1091,10 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	      parmse.expr = null_pointer_node;
               if (arg->missing_arg_type == BT_CHARACTER)
                 {
-                  stringargs = gfc_chainon_list (stringargs,
-                      convert (gfc_strlen_type_node, integer_zero_node));
+                  stringargs =
+		    gfc_chainon_list (stringargs,
+				      convert (gfc_strlen_type_node,
+					       integer_zero_node));
                 }
 	    }
 	}
@@ -1589,7 +1602,6 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
   gfc_ss *lss;
   gfc_ss *rss;
   stmtblock_t block;
-  tree tmp;
 
   gfc_start_block (&block);
 
@@ -1607,7 +1619,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
       gfc_conv_expr (&rse, expr2);
       gfc_add_block_to_block (&block, &lse.pre);
       gfc_add_block_to_block (&block, &rse.pre);
-      gfc_add_modify_expr (&block, lse.expr, rse.expr);
+      gfc_add_modify_expr (&block, lse.expr,
+			   fold_convert (TREE_TYPE (lse.expr), rse.expr));
       gfc_add_block_to_block (&block, &rse.post);
       gfc_add_block_to_block (&block, &lse.post);
     }
@@ -1618,9 +1631,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
       if (expr2->expr_type == EXPR_NULL)
         {
           lse.expr = gfc_conv_descriptor_data (lse.expr);
-          rse.expr = null_pointer_node;
-          tmp = build_v (MODIFY_EXPR, lse.expr, rse.expr);
-          gfc_add_expr_to_block (&block, tmp);
+          rse.expr = fold_convert (TREE_TYPE (lse.expr), null_pointer_node);
+          gfc_add_modify_expr (&block, lse.expr, rse.expr);
         }
       else
         {
@@ -1690,7 +1702,8 @@ gfc_trans_scalar_assign (gfc_se * lse, gfc_se * rse, bt type)
       gfc_add_block_to_block (&block, &lse->pre);
       gfc_add_block_to_block (&block, &rse->pre);
 
-      gfc_add_modify_expr (&block, lse->expr, rse->expr);
+      gfc_add_modify_expr (&block, lse->expr,
+			   fold_convert (TREE_TYPE (lse->expr), rse->expr));
     }
 
   gfc_add_block_to_block (&block, &lse->post);

gcc/fortran/trans-intrinsic.c

@@ -228,7 +228,8 @@ build_fixbound_expr (stmtblock_t * pblock, tree arg, tree type, int up)
   tmp = convert (argtype, intval);
   cond = build (up ? GE_EXPR : LE_EXPR, boolean_type_node, tmp, arg);
 
-  tmp = build (up ? PLUS_EXPR : MINUS_EXPR, type, intval, integer_one_node);
+  tmp = build (up ? PLUS_EXPR : MINUS_EXPR, type, intval,
+	       convert (type, integer_one_node));
   tmp = build (COND_EXPR, type, cond, intval, tmp);
   return tmp;
 }
@@ -651,7 +652,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
       bound = argse.expr;
       /* Convert from one based to zero based.  */
       bound = fold (build (MINUS_EXPR, gfc_array_index_type, bound,
-                    integer_one_node));
+			   gfc_index_one_node));
     }
 
   /* TODO: don't re-evaluate the descriptor on each iteration.  */
@@ -677,7 +678,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
         {
           bound = gfc_evaluate_now (bound, &se->pre);
           cond = fold (build (LT_EXPR, boolean_type_node, bound,
-                              integer_zero_node));
+                              convert (TREE_TYPE (bound), integer_zero_node)));
           tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
           tmp = fold (build (GE_EXPR, boolean_type_node, bound, tmp));
           cond = fold(build (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp));
@@ -1172,7 +1173,9 @@ gfc_conv_intrinsic_anyall (gfc_se * se, gfc_expr * expr, int op)
   gfc_conv_expr_val (&arrayse, actual->expr);
 
   gfc_add_block_to_block (&body, &arrayse.pre);
-  tmp = build (op, boolean_type_node, arrayse.expr, integer_zero_node);
+  tmp = build (op, boolean_type_node, arrayse.expr,
+	       fold_convert (TREE_TYPE (arrayse.expr),
+			     integer_zero_node));
   tmp = build_v (COND_EXPR, tmp, found, build_empty_stmt ());
   gfc_add_expr_to_block (&body, tmp);
   gfc_add_block_to_block (&body, &arrayse.post);
@@ -1214,7 +1217,7 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
   type = gfc_typenode_for_spec (&expr->ts);
   /* Initialize the result.  */
   resvar = gfc_create_var (type, "count");
-  gfc_add_modify_expr (&se->pre, resvar, integer_zero_node);
+  gfc_add_modify_expr (&se->pre, resvar, convert (type, integer_zero_node));
 
   /* Walk the arguments.  */
   arrayss = gfc_walk_expr (actual->expr);
@@ -1232,7 +1235,8 @@ gfc_conv_intrinsic_count (gfc_se * se, gfc_expr * expr)
   /* Generate the loop body.  */
   gfc_start_scalarized_body (&loop, &body);
 
-  tmp = build (PLUS_EXPR, TREE_TYPE (resvar), resvar, integer_one_node);
+  tmp = build (PLUS_EXPR, TREE_TYPE (resvar), resvar,
+	       convert (TREE_TYPE (resvar), integer_one_node));
   tmp = build_v (MODIFY_EXPR, resvar, tmp);
 
   gfc_init_se (&arrayse, NULL);
@@ -1453,7 +1457,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
      array, in case all elements are equal to the limit.
      ie. pos = (ubound >= lbound) ? lbound, lbound - 1;  */
   tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
-	             loop.from[0], integer_one_node));
+	             loop.from[0], gfc_index_one_node));
   cond = fold (build (GE_EXPR, boolean_type_node,
 		      loop.to[0], loop.from[0]));
   tmp = fold (build (COND_EXPR, gfc_array_index_type, cond,
@@ -1522,7 +1526,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
 
   /* Return a value in the range 1..SIZE(array).  */
   tmp = fold (build (MINUS_EXPR, gfc_array_index_type, loop.from[0],
-		     integer_one_node));
+		     gfc_index_one_node));
   tmp = fold (build (MINUS_EXPR, gfc_array_index_type, pos, tmp));
   /* And convert to the required type.  */
   se->expr = convert (type, tmp);
@@ -1670,9 +1674,10 @@ gfc_conv_intrinsic_btest (gfc_se * se, gfc_expr * expr)
   arg = TREE_VALUE (arg);
   type = TREE_TYPE (arg);
 
-  tmp = build (LSHIFT_EXPR, type, integer_one_node, arg2);
+  tmp = build (LSHIFT_EXPR, type, convert (type, integer_one_node), arg2);
   tmp = build (BIT_AND_EXPR, type, arg, tmp);
-  tmp = fold (build (NE_EXPR, boolean_type_node, tmp, integer_zero_node));
+  tmp = fold (build (NE_EXPR, boolean_type_node, tmp,
+		     convert (type, integer_zero_node)));
   type = gfc_typenode_for_spec (&expr->ts);
   se->expr = convert (type, tmp);
 }
@@ -1720,7 +1725,8 @@ gfc_conv_intrinsic_singlebitop (gfc_se * se, gfc_expr * expr, int set)
   arg = TREE_VALUE (arg);
   type = TREE_TYPE (arg);
 
-  tmp = fold (build (LSHIFT_EXPR, type, integer_one_node, arg2));
+  tmp = fold (build (LSHIFT_EXPR, type,
+		     convert (type, integer_one_node), arg2));
   if (set)
     op = BIT_IOR_EXPR;
   else
@@ -1783,11 +1789,13 @@ gfc_conv_intrinsic_ishft (gfc_se * se, gfc_expr * expr)
   tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2);
   rshift = build (RSHIFT_EXPR, type, arg, tmp);
 
-  tmp = build (GT_EXPR, boolean_type_node, arg2, integer_zero_node);
+  tmp = build (GT_EXPR, boolean_type_node, arg2,
+	       convert (TREE_TYPE (arg2), integer_zero_node));
   rshift = build (COND_EXPR, type, tmp, lshift, rshift);
 
   /* Do nothing if shift == 0.  */
-  tmp = build (EQ_EXPR, boolean_type_node, arg2, integer_zero_node);
+  tmp = build (EQ_EXPR, boolean_type_node, arg2,
+	       convert (TREE_TYPE (arg2), integer_zero_node));
   se->expr = build (COND_EXPR, type, tmp, arg, rshift);
 }
 
@@ -1843,11 +1851,13 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr)
   tmp = build1 (NEGATE_EXPR, TREE_TYPE (arg2), arg2);
   rrot = build (RROTATE_EXPR, type, arg, tmp);
 
-  tmp = build (GT_EXPR, boolean_type_node, arg2, integer_zero_node);
+  tmp = build (GT_EXPR, boolean_type_node, arg2,
+	       convert (TREE_TYPE (arg2), integer_zero_node));
   rrot = build (COND_EXPR, type, tmp, lrot, rrot);
 
   /* Do nothing if shift == 0.  */
-  tmp = build (EQ_EXPR, boolean_type_node, arg2, integer_zero_node);
+  tmp = build (EQ_EXPR, boolean_type_node, arg2,
+	       convert (TREE_TYPE (arg2), integer_zero_node));
   se->expr = build (COND_EXPR, type, tmp, arg, rrot);
 }
 
@@ -2040,7 +2050,8 @@ gfc_conv_intrinsic_strcmp (gfc_se * se, gfc_expr * expr, int op)
   se->expr = gfc_build_function_call (gfor_fndecl_compare_string, args);
 
   type = gfc_typenode_for_spec (&expr->ts);
-  se->expr = build (op, type, se->expr, integer_zero_node);
+  se->expr = build (op, type, se->expr,
+		    convert (TREE_TYPE (se->expr), integer_zero_node));
 }
 
 /* Generate a call to the adjustl/adjustr library function.  */
@@ -2130,7 +2141,8 @@ gfc_conv_allocated (gfc_se *se, gfc_expr *expr)
   gfc_conv_expr_descriptor (&arg1se, arg1->expr, ss1);
 
   tmp = gfc_conv_descriptor_data (arg1se.expr);
-  tmp = build (NE_EXPR, boolean_type_node, tmp, null_pointer_node);
+  tmp = build (NE_EXPR, boolean_type_node, tmp,
+	       fold_convert (TREE_TYPE (tmp), null_pointer_node));
   se->expr = convert (gfc_typenode_for_spec (&expr->ts), tmp);
 }
 
@@ -2176,7 +2188,8 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
           gfc_conv_expr_lhs (&arg1se, arg1->expr);
           tmp2 = gfc_conv_descriptor_data (arg1se.expr);
         }
-      tmp = build (NE_EXPR, boolean_type_node, tmp2, null_pointer_node);
+      tmp = build (NE_EXPR, boolean_type_node, tmp2,
+		   fold_convert (TREE_TYPE (tmp2), null_pointer_node));
       se->expr = tmp;
     }
   else
@@ -2450,7 +2463,8 @@ gfc_conv_intrinsic_rrspacing (gfc_se * se, gfc_expr * expr)
 
    cond2 = build (EQ_EXPR, boolean_type_node, rcs.frac, zero);
    cond = build (TRUTH_ANDIF_EXPR, boolean_type_node, cond, cond2);
-   tmp = build (COND_EXPR, masktype, cond, integer_zero_node, tmp);
+   tmp = build (COND_EXPR, masktype, cond,
+		convert (masktype, integer_zero_node), tmp);
 
    tmp = build1 (VIEW_CONVERT_EXPR, rcs.type, tmp);
    se->expr = tmp;
@@ -2527,7 +2541,8 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
   gfc_add_expr_to_block (&se->pre, tmp);
 
   /* Free the temporary afterwards, if necessary.  */
-  cond = build (GT_EXPR, boolean_type_node, len, integer_zero_node);
+  cond = build (GT_EXPR, boolean_type_node, len,
+		convert (TREE_TYPE (len), integer_zero_node));
   arglist = gfc_chainon_list (NULL_TREE, var);
   tmp = gfc_build_function_call (gfor_fndecl_internal_free, arglist);
   tmp = build_v (COND_EXPR, cond, tmp, build_empty_stmt ());

gcc/fortran/trans-io.c

@@ -410,7 +410,8 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
       msg =
         gfc_build_string_const (37, "Assigned label is not a format label");
       tmp = GFC_DECL_STRING_LEN (se.expr);
-      tmp = build (LE_EXPR, boolean_type_node, tmp, integer_minus_one_node);
+      tmp = build (LE_EXPR, boolean_type_node,
+		   tmp, convert (TREE_TYPE (tmp), integer_minus_one_node));
       gfc_trans_runtime_check (tmp, msg, &se.pre);
       gfc_add_modify_expr (&se.pre, io, GFC_DECL_ASSIGN_ADDR (se.expr));
       gfc_add_modify_expr (&se.pre, len, GFC_DECL_STRING_LEN (se.expr));
@@ -418,7 +419,7 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
   else
     {
       gfc_conv_string_parameter (&se);
-      gfc_add_modify_expr (&se.pre, io, se.expr);
+      gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), se.expr));
       gfc_add_modify_expr (&se.pre, len, se.string_length);
     }
 
@@ -432,10 +433,10 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
 static void
 set_flag (stmtblock_t *block, tree var)
 {
-  tree tmp;
+  tree tmp, type = TREE_TYPE (var);
 
-  tmp = build (COMPONENT_REF, TREE_TYPE(var), ioparm_var, var, NULL_TREE);
-  gfc_add_modify_expr (block, tmp, integer_one_node);
+  tmp = build (COMPONENT_REF, type, ioparm_var, var, NULL_TREE);
+  gfc_add_modify_expr (block, tmp, convert (type, integer_one_node));
 }
 
 

gcc/fortran/trans-stmt.c

@@ -615,7 +615,7 @@ gfc_trans_do (gfc_code * code)
   gfc_add_modify_expr (&body, dovar, tmp);
 
   /* Decrement the loop count.  */
-  tmp = build (MINUS_EXPR, type, count, integer_one_node);
+  tmp = build (MINUS_EXPR, type, count, gfc_index_one_node);
   gfc_add_modify_expr (&body, count, tmp);
 
   /* End of loop body.  */
@@ -1240,13 +1240,13 @@ gfc_trans_forall_loop (forall_info *forall_tmp, int nvar, tree body, int mask_fl
           maskindex = forall_tmp->maskindex;
           if (mask)
             {
-              tmp = build (PLUS_EXPR, gfc_array_index_type, maskindex,
-                           integer_one_node);
+              tmp = build (PLUS_EXPR, gfc_array_index_type,
+                           maskindex, gfc_index_one_node);
               gfc_add_modify_expr (&block, maskindex, tmp);
             }
         }
       /* Decrement the loop counter.  */
-      tmp = build (MINUS_EXPR, TREE_TYPE (var), count, integer_one_node);
+      tmp = build (MINUS_EXPR, TREE_TYPE (var), count, gfc_index_one_node);
       gfc_add_modify_expr (&block, count, tmp);
 
       body = gfc_finish_block (&block);
@@ -1348,12 +1348,12 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock,
   if (INTEGER_CST_P (size))
     {
       tmp = fold (build (MINUS_EXPR, gfc_array_index_type, size,
-			 integer_one_node));
+			 gfc_index_one_node));
     }
   else
     tmp = NULL_TREE;
 
-  type = build_range_type (gfc_array_index_type, integer_zero_node, tmp);
+  type = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
   type = build_array_type (elem_type, type);
   if (gfc_can_put_var_on_stack (bytesize))
     {
@@ -1438,7 +1438,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
 
       gfc_mark_ss_chain_used (lss, 1);
       /* Initialize count2.  */
-      gfc_add_modify_expr (&block, count2, integer_zero_node);
+      gfc_add_modify_expr (&block, count2, gfc_index_zero_node);
 
       /* Start the scalarized loop body.  */
       gfc_start_scalarized_body (&loop1, &body);
@@ -1480,15 +1480,15 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
       gfc_add_expr_to_block (&body, tmp);
 
       /* Increment count2.  */
-      tmp = fold (build (PLUS_EXPR, TREE_TYPE (count2), count2,
-                         integer_one_node));
+      tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+			 count2, gfc_index_one_node));
       gfc_add_modify_expr (&body, count2, tmp);
 
       /* Increment count3.  */
       if (count3)
         {
-          tmp = fold (build (PLUS_EXPR, TREE_TYPE (count3), count3,
-                             integer_one_node));
+          tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                             count3, gfc_index_one_node));
           gfc_add_modify_expr (&body, count3, tmp);
         }
 
@@ -1537,7 +1537,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
   else
     {
       /* Initilize count2.  */
-      gfc_add_modify_expr (&block, count2, integer_zero_node);
+      gfc_add_modify_expr (&block, count2, gfc_index_zero_node);
 
       /* Initiliaze the loop.  */
       gfc_init_loopinfo (&loop);
@@ -1592,15 +1592,15 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
   else
     {
       /* Increment count2.  */
-      tmp = fold (build (PLUS_EXPR, gfc_array_index_type, count2,
-			 integer_one_node));
+      tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+			 count2, gfc_index_one_node));
       gfc_add_modify_expr (&body1, count2, tmp);
 
       /* Increment count3.  */
       if (count3)
         {
-          tmp = fold (build (PLUS_EXPR, gfc_array_index_type, count3,
-                             integer_one_node));
+          tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                             count3, gfc_index_one_node));
           gfc_add_modify_expr (&body1, count3, tmp);
         }
 
@@ -1639,7 +1639,7 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
   *lss = gfc_walk_expr (expr1);
   *rss = NULL;
 
-  size = integer_one_node;
+  size = gfc_index_one_node;
   if (*lss != gfc_ss_terminator)
     {
       gfc_init_loopinfo (&loop);
@@ -1672,10 +1672,11 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
       /* Figure out how many elements we need.  */
       for (i = 0; i < loop.dimen; i++)
         {
-	  tmp = fold (build (MINUS_EXPR, TREE_TYPE (loop.from[i]),
-			     integer_one_node, loop.from[i]));
-          tmp = fold (build (PLUS_EXPR, TREE_TYPE (tmp), tmp, loop.to[i]));
-          size = fold (build (MULT_EXPR, TREE_TYPE (size), size, tmp));
+	  tmp = fold (build (MINUS_EXPR, gfc_array_index_type,
+			     gfc_index_one_node, loop.from[i]));
+          tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+			     tmp, loop.to[i]));
+          size = fold (build (MULT_EXPR, gfc_array_index_type, size, tmp));
         }
       gfc_add_block_to_block (pblock, &loop.pre);
       size = gfc_evaluate_now (size, pblock);
@@ -1700,7 +1701,7 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
 
   /* TODO: optimizing the computing process.  */
   number = gfc_create_var (gfc_array_index_type, "num");
-  gfc_add_modify_expr (block, number, integer_zero_node);
+  gfc_add_modify_expr (block, number, gfc_index_zero_node);
 
   gfc_start_block (&body);
   if (nested_forall_info)
@@ -1778,13 +1779,13 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
   if (wheremask)
     {
       count = gfc_create_var (gfc_array_index_type, "count");
-      gfc_add_modify_expr (block, count, integer_zero_node);
+      gfc_add_modify_expr (block, count, gfc_index_zero_node);
     }
   else
     count = NULL;
 
   /* Initialize count1.  */
-  gfc_add_modify_expr (block, count1, integer_zero_node);
+  gfc_add_modify_expr (block, count1, gfc_index_zero_node);
 
   /* Calculate the size of temporary needed in the assignment. Return loop, lss
      and rss which are used in function generate_loop_for_rhs_to_temp().  */
@@ -1805,7 +1806,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
       mask = forall_tmp->mask;
       maskindex = forall_tmp->maskindex;
       if (mask)
-        gfc_add_modify_expr (block, maskindex, integer_zero_node);
+        gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
       forall_tmp = forall_tmp->next_nest;
     }
 
@@ -1819,7 +1820,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
   gfc_add_expr_to_block (block, tmp);
 
   /* Reset count1.  */
-  gfc_add_modify_expr (block, count1, integer_zero_node);
+  gfc_add_modify_expr (block, count1, gfc_index_zero_node);
 
   /* Reset maskindexed.  */
   forall_tmp = nested_forall_info;
@@ -1828,13 +1829,13 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
       mask = forall_tmp->mask;
       maskindex = forall_tmp->maskindex;
       if (mask)
-        gfc_add_modify_expr (block, maskindex, integer_zero_node);
+        gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
       forall_tmp = forall_tmp->next_nest;
     }
 
   /* Reset count.  */
   if (wheremask)
-    gfc_add_modify_expr (block, count, integer_zero_node);
+    gfc_add_modify_expr (block, count, gfc_index_zero_node);
 
   /* Generate codes to copy the temporary to lhs.  */
   tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, inner_size, count,
@@ -1879,7 +1880,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
   forall_info *forall_tmp;
 
   count = gfc_create_var (gfc_array_index_type, "count");
-  gfc_add_modify_expr (block, count, integer_zero_node);
+  gfc_add_modify_expr (block, count, gfc_index_zero_node);
 
   inner_size = integer_one_node;
   lss = gfc_walk_expr (expr1);
@@ -1904,8 +1905,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       gfc_add_block_to_block (&body, &rse.post);
 
       /* Increment count.  */
-      tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count,
-                         integer_one_node));
+      tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                         count, gfc_index_one_node));
       gfc_add_modify_expr (&body, count, tmp);
 
       tmp = gfc_finish_block (&body);
@@ -1917,7 +1918,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
           mask = forall_tmp->mask;
           maskindex = forall_tmp->maskindex;
           if (mask)
-            gfc_add_modify_expr (block, maskindex, integer_zero_node);
+            gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
           forall_tmp = forall_tmp->next_nest;
         }
 
@@ -1927,7 +1928,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       gfc_add_expr_to_block (block, tmp);
 
       /* Reset count.  */
-      gfc_add_modify_expr (block, count, integer_zero_node);
+      gfc_add_modify_expr (block, count, gfc_index_zero_node);
 
       /* Reset maskindexes.  */
       forall_tmp = nested_forall_info;
@@ -1936,7 +1937,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
           mask = forall_tmp->mask;
           maskindex = forall_tmp->maskindex;
           if (mask)
-            gfc_add_modify_expr (block, maskindex, integer_zero_node);
+            gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
           forall_tmp = forall_tmp->next_nest;
         }
       gfc_start_block (&body);
@@ -1949,8 +1950,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       gfc_add_modify_expr (&body, lse.expr, rse.expr);
       gfc_add_block_to_block (&body, &lse.post);
       /* Increment count.  */
-      tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count,
-                         integer_one_node));
+      tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                         count, gfc_index_one_node));
       gfc_add_modify_expr (&body, count, tmp);
       tmp = gfc_finish_block (&body);
 
@@ -1993,8 +1994,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       gfc_add_block_to_block (&body, &lse.post);
 
       /* Increment count.  */
-      tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count,
-                         integer_one_node));
+      tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                         count, gfc_index_one_node));
       gfc_add_modify_expr (&body, count, tmp);
 
       tmp = gfc_finish_block (&body);
@@ -2006,7 +2007,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
           mask = forall_tmp->mask;
           maskindex = forall_tmp->maskindex;
           if (mask)
-            gfc_add_modify_expr (block, maskindex, integer_zero_node);
+            gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
           forall_tmp = forall_tmp->next_nest;
         }
 
@@ -2016,7 +2017,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       gfc_add_expr_to_block (block, tmp);
 
       /* Reset count.  */
-      gfc_add_modify_expr (block, count, integer_zero_node);
+      gfc_add_modify_expr (block, count, gfc_index_zero_node);
 
       /* Reset maskindexes.  */
       forall_tmp = nested_forall_info;
@@ -2025,7 +2026,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
           mask = forall_tmp->mask;
           maskindex = forall_tmp->maskindex;
           if (mask)
-            gfc_add_modify_expr (block, maskindex, integer_zero_node);
+            gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
           forall_tmp = forall_tmp->next_nest;
         }
       parm = gfc_build_array_ref (tmp1, count);
@@ -2038,8 +2039,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       gfc_add_block_to_block (&body, &lse.post);
 
       /* Increment count.  */
-      tmp = fold (build (PLUS_EXPR, TREE_TYPE (count), count,
-                         integer_one_node));
+      tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                         count, gfc_index_one_node));
       gfc_add_modify_expr (&body, count, tmp);
 
       tmp = gfc_finish_block (&body);
@@ -2207,7 +2208,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
   /* Work out the number of elements in the mask array.  */
   tmpvar = NULL_TREE;
   lenvar = NULL_TREE;
-  size = integer_one_node;
+  size = gfc_index_one_node;
   sizevar = NULL_TREE;
 
   for (n = 0; n < nvar; n++)
@@ -2257,7 +2258,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
       info->mask = mask;
       info->maskindex = maskindex;
 
-      gfc_add_modify_expr (&block, maskindex, integer_zero_node);
+      gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node);
 
       /* Start of mask assignment loop body.  */
       gfc_start_block (&body);
@@ -2278,8 +2279,8 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
       gfc_add_modify_expr (&body, tmp, se.expr);
 
       /* Advance to the next mask element.  */
-      tmp = build (PLUS_EXPR, gfc_array_index_type, maskindex,
-		   integer_one_node);
+      tmp = build (PLUS_EXPR, gfc_array_index_type,
+		   maskindex, gfc_index_one_node);
       gfc_add_modify_expr (&body, maskindex, tmp);
 
       /* Generate the loops.  */
@@ -2317,7 +2318,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
 
               /* Reset the mask index.  */
               if (mask)
-                gfc_add_modify_expr (&block, maskindex, integer_zero_node);
+                gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node);
 
               /* Generate body and loops.  */
               tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1, 1);
@@ -2362,7 +2363,7 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
 
               /* Reset the mask index.  */
               if (mask)
-                gfc_add_modify_expr (&block, maskindex, integer_zero_node);
+                gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node);
 
               /* Generate body and loops.  */
               tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign,
@@ -2478,7 +2479,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
   /* Variable to index the temporary.  */
   count = gfc_create_var (gfc_array_index_type, "count");
   /* Initilize count.  */
-  gfc_add_modify_expr (block, count, integer_zero_node);
+  gfc_add_modify_expr (block, count, gfc_index_zero_node);
 
   gfc_start_block (&body);
 
@@ -2530,7 +2531,7 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
     {
       /* Increment count.  */
       tmp1 = fold (build (PLUS_EXPR, gfc_array_index_type, count,
-                          integer_one_node));
+                          gfc_index_one_node));
       gfc_add_modify_expr (&body1, count, tmp1);
 
       /* Generate the copying loops.  */
@@ -2696,8 +2697,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
   if (lss == gfc_ss_terminator)
     {
       /* Increment count1.  */
-      tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1,
-                         integer_one_node));
+      tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                         count1, gfc_index_one_node));
       gfc_add_modify_expr (&body, count1, tmp);
 
       /* Use the scalar assignment as is.  */
@@ -2714,8 +2715,8 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
         {
           /* Increment count1 before finish the main body of a scalarized
              expression.  */
-          tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1,
-                             integer_one_node));
+          tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                             count1, gfc_index_one_node));
           gfc_add_modify_expr (&body, count1, tmp);
           gfc_trans_scalarized_loop_boundary (&loop, &body);
 
@@ -2758,16 +2759,17 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2, tree mask,
           tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts.type);
           tmp = build_v (COND_EXPR, maskexpr, tmp, build_empty_stmt ());
           gfc_add_expr_to_block (&body, tmp);
+
           /* Increment count2.  */
-          tmp = fold (build (PLUS_EXPR, TREE_TYPE (count2), count2,
-                             integer_one_node));
+          tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                             count2, gfc_index_one_node));
           gfc_add_modify_expr (&body, count2, tmp);
         }
       else
         {
           /* Increment count1.  */
-          tmp = fold (build (PLUS_EXPR, TREE_TYPE (count1), count1,
-                             integer_one_node));
+          tmp = fold (build (PLUS_EXPR, gfc_array_index_type,
+                             count1, gfc_index_one_node));
           gfc_add_modify_expr (&body, count1, tmp);
         }
 
@@ -2876,8 +2878,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
                       /* Variables to control maskexpr.  */
                       count1 = gfc_create_var (gfc_array_index_type, "count1");
                       count2 = gfc_create_var (gfc_array_index_type, "count2");
-                      gfc_add_modify_expr (block, count1, integer_zero_node);
-                      gfc_add_modify_expr (block, count2, integer_zero_node);
+                      gfc_add_modify_expr (block, count1, gfc_index_zero_node);
+                      gfc_add_modify_expr (block, count2, gfc_index_zero_node);
 
                       tmp = gfc_trans_where_assign (expr1, expr2, mask, count1,
                                                     count2);
@@ -2891,8 +2893,8 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
                   /* Variables to control maskexpr.  */
                   count1 = gfc_create_var (gfc_array_index_type, "count1");
                   count2 = gfc_create_var (gfc_array_index_type, "count2");
-                  gfc_add_modify_expr (block, count1, integer_zero_node);
-                  gfc_add_modify_expr (block, count2, integer_zero_node);
+                  gfc_add_modify_expr (block, count1, gfc_index_zero_node);
+                  gfc_add_modify_expr (block, count2, gfc_index_zero_node);
 
                   tmp = gfc_trans_where_assign (expr1, expr2, mask, count1,
                                                 count2);

gcc/fortran/trans-types.c

@@ -290,7 +290,7 @@ gfc_get_character_type (int kind, gfc_charlen * cl)
 
   len = (cl == 0) ? NULL_TREE : cl->backend_decl;
 
-  bounds = build_range_type (gfc_array_index_type, integer_one_node, len);
+  bounds = build_range_type (gfc_array_index_type, gfc_index_one_node, len);
   type = build_array_type (base, bounds);
   TYPE_STRING_FLAG (type) = 1;
 
@@ -493,7 +493,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as)
     {
       /* Create expressions for the known bounds of the array.  */
       if (as->type == AS_ASSUMED_SHAPE && as->lower[n] == NULL)
-        lbound[n] = integer_one_node;
+        lbound[n] = gfc_index_one_node;
       else
         lbound[n] = gfc_conv_array_bound (as->lower[n]);
       ubound[n] = gfc_conv_array_bound (as->upper[n]);
@@ -727,7 +727,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
 
   GFC_TYPE_ARRAY_DTYPE (type) = gfc_get_dtype (etype, as->rank);
   GFC_TYPE_ARRAY_RANK (type) = as->rank;
-  range = build_range_type (gfc_array_index_type, integer_zero_node,
+  range = build_range_type (gfc_array_index_type, gfc_index_zero_node,
 			    NULL_TREE);
   /* TODO: use main type if it is unbounded.  */
   GFC_TYPE_ARRAY_DATAPTR_TYPE (type) =
@@ -741,7 +741,7 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, int packed)
   else
     range = NULL_TREE;
 
-  range = build_range_type (gfc_array_index_type, integer_zero_node, range);
+  range = build_range_type (gfc_array_index_type, gfc_index_zero_node, range);
   TYPE_DOMAIN (type) = range;
 
   build_pointer_type (etype);
@@ -806,7 +806,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
 
   /* Build an array descriptor record type.  */
   if (packed != 0)
-    stride = integer_one_node;
+    stride = gfc_index_one_node;
   else
     stride = NULL_TREE;
 
@@ -840,7 +840,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
 	{
 	  tmp = fold (build (MINUS_EXPR, gfc_array_index_type, upper, lower));
 	  tmp = fold (build (PLUS_EXPR, gfc_array_index_type, tmp,
-			     integer_one_node));
+			     gfc_index_one_node));
 	  stride =
 	    fold (build (MULT_EXPR, gfc_array_index_type, tmp, stride));
 	  /* Check the folding worked.  */
@@ -858,7 +858,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
   arraytype =
     build_array_type (etype,
 		      build_range_type (gfc_array_index_type,
-					integer_zero_node, NULL_TREE));
+					gfc_index_zero_node, NULL_TREE));
   arraytype = build_pointer_type (arraytype);
   GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
 
@@ -885,7 +885,7 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
   arraytype =
     build_array_type (gfc_get_desc_dim_type (),
 		      build_range_type (gfc_array_index_type,
-					integer_zero_node,
+					gfc_index_zero_node,
 					gfc_rank_cst[dimen - 1]));
 
   decl = build_decl (FIELD_DECL, get_identifier ("dim"), arraytype);

gcc/fortran/trans.c

@@ -146,6 +146,16 @@ gfc_add_modify_expr (stmtblock_t * pblock, tree lhs, tree rhs)
 {
   tree tmp;
 
+#ifdef ENABLE_CHECKING
+  /* Make sure that the types of the rhs and the lhs are the same
+     for scalar assignments.  We should probably have something
+     similar for aggregates, but right now removing that check just
+     breaks everything.  */
+  if (TREE_TYPE (rhs) != TREE_TYPE (lhs)
+      && !AGGREGATE_TYPE_P (TREE_TYPE (lhs)))
+    abort ();
+#endif
+
   tmp = fold (build_v (MODIFY_EXPR, lhs, rhs));
   gfc_add_expr_to_block (pblock, tmp);
 }