+ if (rank_remap)
+ gfc_add_block_to_block (&block, &rse.pre);
+
+ /* If we do bounds remapping, update LHS descriptor accordingly. */
+ if (remap)
+ {
+ int dim;
+ gcc_assert (remap->u.ar.dimen == expr1->rank);
+
+ if (rank_remap)
+ {
+ /* Do rank remapping. We already have the RHS's descriptor
+ converted in rse and now have to build the correct LHS
+ descriptor for it. */
+
+ tree dtype, data;
+ tree offs, stride;
+ tree lbound, ubound;
+
+ /* Set dtype. */
+ dtype = gfc_conv_descriptor_dtype (desc);
+ tmp = gfc_get_dtype (TREE_TYPE (desc));
+ gfc_add_modify (&block, dtype, tmp);
+
+ /* Copy data pointer. */
+ data = gfc_conv_descriptor_data_get (rse.expr);
+ gfc_conv_descriptor_data_set (&block, desc, data);
+
+ /* Copy offset but adjust it such that it would correspond
+ to a lbound of zero. */
+ offs = gfc_conv_descriptor_offset_get (rse.expr);
+ for (dim = 0; dim < expr2->rank; ++dim)
+ {
+ stride = gfc_conv_descriptor_stride_get (rse.expr,
+ gfc_rank_cst[dim]);
+ lbound = gfc_conv_descriptor_lbound_get (rse.expr,
+ gfc_rank_cst[dim]);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, stride, lbound);
+ offs = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, offs, tmp);
+ }
+ gfc_conv_descriptor_offset_set (&block, desc, offs);
+
+ /* Set the bounds as declared for the LHS and calculate strides as
+ well as another offset update accordingly. */
+ stride = gfc_conv_descriptor_stride_get (rse.expr,
+ gfc_rank_cst[0]);
+ for (dim = 0; dim < expr1->rank; ++dim)
+ {
+ gfc_se lower_se;
+ gfc_se upper_se;
+
+ gcc_assert (remap->u.ar.start[dim] && remap->u.ar.end[dim]);
+
+ /* Convert declared bounds. */
+ gfc_init_se (&lower_se, NULL);
+ gfc_init_se (&upper_se, NULL);
+ gfc_conv_expr (&lower_se, remap->u.ar.start[dim]);
+ gfc_conv_expr (&upper_se, remap->u.ar.end[dim]);
+
+ gfc_add_block_to_block (&block, &lower_se.pre);
+ gfc_add_block_to_block (&block, &upper_se.pre);
+
+ lbound = fold_convert (gfc_array_index_type, lower_se.expr);
+ ubound = fold_convert (gfc_array_index_type, upper_se.expr);
+
+ lbound = gfc_evaluate_now (lbound, &block);
+ ubound = gfc_evaluate_now (ubound, &block);
+
+ gfc_add_block_to_block (&block, &lower_se.post);
+ gfc_add_block_to_block (&block, &upper_se.post);
+
+ /* Set bounds in descriptor. */
+ gfc_conv_descriptor_lbound_set (&block, desc,
+ gfc_rank_cst[dim], lbound);
+ gfc_conv_descriptor_ubound_set (&block, desc,
+ gfc_rank_cst[dim], ubound);
+
+ /* Set stride. */
+ stride = gfc_evaluate_now (stride, &block);
+ gfc_conv_descriptor_stride_set (&block, desc,
+ gfc_rank_cst[dim], stride);
+
+ /* Update offset. */
+ offs = gfc_conv_descriptor_offset_get (desc);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, lbound, stride);
+ offs = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offs, tmp);
+ offs = gfc_evaluate_now (offs, &block);
+ gfc_conv_descriptor_offset_set (&block, desc, offs);
+
+ /* Update stride. */
+ tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
+ stride = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, stride, tmp);
+ }
+ }
+ else
+ {
+ /* Bounds remapping. Just shift the lower bounds. */
+
+ gcc_assert (expr1->rank == expr2->rank);
+
+ for (dim = 0; dim < remap->u.ar.dimen; ++dim)
+ {
+ gfc_se lbound_se;
+
+ gcc_assert (remap->u.ar.start[dim]);
+ gcc_assert (!remap->u.ar.end[dim]);
+ gfc_init_se (&lbound_se, NULL);
+ gfc_conv_expr (&lbound_se, remap->u.ar.start[dim]);
+
+ gfc_add_block_to_block (&block, &lbound_se.pre);
+ gfc_conv_shift_descriptor_lbound (&block, desc,
+ dim, lbound_se.expr);
+ gfc_add_block_to_block (&block, &lbound_se.post);
+ }
+ }
+ }