PR fortran/50420

[pf3gnuchains/gcc-fork.git] / gcc / fortran / trans-array.c

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 79dbafa..0da1720 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1458,8 +1458,8 @@ gfc_trans_array_constructor_value (stmtblock_t * pblock, tree type,
              size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type));
              bound = build_int_cst (size_type_node, n * size);
              tmp = build_call_expr_loc (input_location,
-                                    built_in_decls[BUILT_IN_MEMCPY], 3,
-                                    tmp, init, bound);
+                                        builtin_decl_explicit (BUILT_IN_MEMCPY),
+                                        3, tmp, init, bound);
              gfc_add_expr_to_block (&body, tmp);
 
              *poffset = fold_build2_loc (input_location, PLUS_EXPR,
@@ -2609,6 +2609,18 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
       /* Temporary array or derived type component.  */
       gcc_assert (se->loop);
       index = se->loop->loopvar[se->loop->order[i]];
+
+      /* Pointer functions can have stride[0] different from unity. 
+        Use the stride returned by the function call and stored in
+        the descriptor for the temporary.  */ 
+      if (se->ss && se->ss->type == GFC_SS_FUNCTION
+           && se->ss->expr
+           && se->ss->expr->symtree
+           && se->ss->expr->symtree->n.sym->result
+           && se->ss->expr->symtree->n.sym->result->attr.pointer)
+       stride = gfc_conv_descriptor_stride_get (info->descriptor,
+                                                gfc_rank_cst[dim]);
+
       if (!integer_zerop (info->delta[dim]))
        index = fold_build2_loc (input_location, PLUS_EXPR,
                                 gfc_array_index_type, index, info->delta[dim]);
@@ -5962,28 +5974,31 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       tree to;
       tree base;
 
+      ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
+
       if (se->want_coarray)
        {
+         gfc_array_ref *ar = &info->ref->u.ar;
+
          codim = gfc_get_corank (expr);
-         for (n = ss->data.info.dimen; n < ss->data.info.dimen + codim - 1;
-              n++)
+         for (n = 0; n < codim - 1; n++)
            {
              /* Make sure we are not lost somehow.  */
-             gcc_assert (info->ref->u.ar.dimen_type[n] == DIMEN_THIS_IMAGE);
+             gcc_assert (ar->dimen_type[n + ndim] == DIMEN_THIS_IMAGE);
 
              /* Make sure the call to gfc_conv_section_startstride won't
                 generate unnecessary code to calculate stride.  */
-             gcc_assert (info->ref->u.ar.stride[n] == NULL);
+             gcc_assert (ar->stride[n + ndim] == NULL);
 
-             gfc_conv_section_startstride (&loop, ss, n);
-             loop.from[n] = info->start[n];
-             loop.to[n]   = info->end[n];
+             gfc_conv_section_startstride (&loop, ss, n + ndim);
+             loop.from[n + loop.dimen] = info->start[n + ndim];
+             loop.to[n + loop.dimen]   = info->end[n + ndim];
            }
 
-         gcc_assert (n == ss->data.info.dimen + codim - 1);
-         evaluate_bound (&loop.pre, info->start, info->ref->u.ar.start,
-                         info->descriptor, n, true);
-         loop.from[n] = info->start[n];
+         gcc_assert (n == codim - 1);
+         evaluate_bound (&loop.pre, info->start, ar->start,
+                         info->descriptor, n + ndim, true);
+         loop.from[n + loop.dimen] = info->start[n + ndim];
        }
       else
        codim = 0;
@@ -6034,7 +6049,6 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       else
        base = NULL_TREE;
 
-      ndim = info->ref ? info->ref->u.ar.dimen : info->dimen;
       for (n = 0; n < ndim; n++)
        {
          stride = gfc_conv_array_stride (desc, n);
@@ -6621,7 +6635,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
          gfc_add_expr_to_block (&block, tmp);
        }
 
-      tmp = built_in_decls[BUILT_IN_MEMCPY];
+      tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
       tmp = build_call_expr_loc (input_location, tmp, 3,
                                 dest, src, size);
     }
@@ -6645,7 +6659,7 @@ duplicate_allocatable (tree dest, tree src, tree type, int rank,
 
       /* We know the temporary and the value will be the same length,
         so can use memcpy.  */
-      tmp = built_in_decls[BUILT_IN_MEMCPY];
+      tmp = builtin_decl_explicit (BUILT_IN_MEMCPY);
       tmp = build_call_expr_loc (input_location,
                        tmp, 3, gfc_conv_descriptor_data_get (dest),
                        gfc_conv_descriptor_data_get (src), size);
@@ -7401,7 +7415,7 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
      in the array reference - (*desc.data)[<element>]. */
   gfc_init_block (&realloc_block);
   tmp = build_call_expr_loc (input_location,
-                            built_in_decls[BUILT_IN_REALLOC], 2,
+                            builtin_decl_explicit (BUILT_IN_REALLOC), 2,
                             fold_convert (pvoid_type_node, array1),
                             size2);
   gfc_conv_descriptor_data_set (&realloc_block,
@@ -7417,8 +7431,8 @@ gfc_alloc_allocatable_for_assignment (gfc_loopinfo *loop,
   /* Malloc expression.  */
   gfc_init_block (&alloc_block);
   tmp = build_call_expr_loc (input_location,
-                            built_in_decls[BUILT_IN_MALLOC], 1,
-                            size2);
+                            builtin_decl_explicit (BUILT_IN_MALLOC),
+                            1, size2);
   gfc_conv_descriptor_data_set (&alloc_block,
                                desc, tmp);
   tmp = gfc_conv_descriptor_dtype (desc);