+2008-10-30 Mikael Morin <mikael.morin@tele2.fr>
+
+ PR fortran/37903
+ * trans-array.c (gfc_trans_create_temp_array): If n is less
+ than the temporary dimension, assert that loop->from is
+ zero (reverts to earlier versions). If there is at least one
+ null loop->to[n], it is a callee allocated array so set the
+ size to NULL and break.
+ (gfc_trans_constant_array_constructor): Set the offset to zero.
+ (gfc_trans_array_constructor): Remove loop shifting around the
+ temporary creation.
+ (gfc_conv_loop_setup): Prefer zero-based descriptors if
+ possible. Calculate the translation from loop variables to
+ array indices if an array constructor.
+
+2008-10-30 Mikael Morin <mikael.morin@tele2.fr>
+
+ PR fortran/37749
+ * trans-array.c (gfc_trans_create_temp_array): If size is NULL
+ use the array bounds for loop->to.
+
2008-10-28 Tobias Burnus <burnus@net-b.de>
* intrinsic.texi: Update OpenMP section for OMPv3.
for (dim = 0; dim < info->dimen; dim++)
{
n = loop->order[dim];
- /* TODO: Investigate why "if (n < loop->temp_dim)
- gcc_assert (integer_zerop (loop->from[n]));" fails here. */
- if (n >= loop->temp_dim)
+ if (n < loop->temp_dim)
+ gcc_assert (integer_zerop (loop->from[n]));
+ else
{
/* Callee allocated arrays may not have a known bound yet. */
if (loop->to[n])
or_expr = NULL_TREE;
+ /* If there is at least one null loop->to[n], it is a callee allocated
+ array. */
for (n = 0; n < info->dimen; n++)
- {
- if (loop->to[n] == NULL_TREE)
+ if (loop->to[n] == NULL_TREE)
+ {
+ size = NULL_TREE;
+ break;
+ }
+
+ for (n = 0; n < info->dimen; n++)
+ {
+ if (size == NULL_TREE)
{
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */
gfc_conv_descriptor_ubound (desc, gfc_rank_cst[n]),
gfc_conv_descriptor_lbound (desc, gfc_rank_cst[n]));
loop->to[n] = tmp;
- size = NULL_TREE;
continue;
}
info->descriptor = tmp;
info->data = build_fold_addr_expr (tmp);
- info->offset = fold_build1 (NEGATE_EXPR, gfc_array_index_type,
- loop->from[0]);
+ info->offset = gfc_index_zero_node;
for (i = 0; i < info->dimen; i++)
{
tree offsetvar;
tree desc;
tree type;
- tree loopfrom;
bool dynamic;
bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val;
}
}
- /* Temporarily reset the loop variables, so that the returned temporary
- has the right size and bounds. This seems only to be necessary for
- 1D arrays. */
- if (!integer_zerop (loop->from[0]) && loop->dimen == 1)
- {
- loopfrom = loop->from[0];
- loop->from[0] = gfc_index_zero_node;
- loop->to[0] = fold_build2 (MINUS_EXPR, gfc_array_index_type,
- loop->to[0], loopfrom);
- }
- else
- loopfrom = NULL_TREE;
-
gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
type, dynamic, true, false, where);
- if (loopfrom != NULL_TREE)
- {
- loop->from[0] = loopfrom;
- loop->to[0] = fold_build2 (PLUS_EXPR, gfc_array_index_type,
- loop->to[0], loopfrom);
- /* In the case of a non-zero from, the temporary needs an offset
- so that subsequent indexing is correct. */
- ss->data.info.offset = fold_build1 (NEGATE_EXPR,
- gfc_array_index_type,
- loop->from[0]);
- }
-
desc = ss->data.info.descriptor;
offset = gfc_index_zero_node;
offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
if (ss->shape)
{
/* The frontend has worked out the size for us. */
- loopspec[n] = ss;
+ if (!loopspec[n] || !loopspec[n]->shape
+ || !integer_zerop (loopspec[n]->data.info.start[n]))
+ /* Prefer zero-based descriptors if possible. */
+ loopspec[n] = ss;
continue;
}
/* Calculate the translation from loop variables to array indices. */
for (ss = loop->ss; ss != gfc_ss_terminator; ss = ss->loop_chain)
{
- if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT)
+ if (ss->type != GFC_SS_SECTION && ss->type != GFC_SS_COMPONENT
+ && ss->type != GFC_SS_CONSTRUCTOR)
+
continue;
info = &ss->data.info;
--- /dev/null
+! { dg-do run }
+!
+! Test the fix for PR37749 in which the expression in line 13 would cause an ICE
+! because the upper value of the loop range was not set.
+!
+! Contributed by Jakub Jelinek <jakub@gcc.gnu.org>
+!
+subroutine subr (m, n, a, b, c, d, p)
+ implicit none
+ integer m, n
+ real a(m,n), b(m,n), c(n,n), d(m,n)
+ integer p(n)
+ d = a(:,p) - matmul(b, c)
+end subroutine
+
+ implicit none
+ integer i
+ real a(3,2), b(3,2), c(2,2), d(3,2)
+ integer p(2)
+ a = reshape ((/(i, i = 1, 6)/), (/3, 2/))
+ b = 1
+ c = 2
+ p = 2
+ call subr (3, 2, a, b, c, d, p)
+ if (any (d .ne. reshape ((/(mod (i + 2, 3), i = 1, 6)/), (/3, 2/)))) call abort
+end