+2006-04-16 Thomas Koenig <Thomas.Koenig@online.de>
+
+ PR fortran/26017
+ * trans-array.c(gfc_array_init_size): Introduce or_expr
+ which is true if the size along any dimension
+ is negative. Create a temporary variable with base
+ name size. If or_expr is true, set the temporary to 0,
+ to the normal size otherwise.
+
2006-04-16 Paul Thomas <pault@gcc.gnu.org>
PR fortran/26822
tree size;
tree offset;
tree stride;
+ tree cond;
+ tree or_expr;
+ tree thencase;
+ tree elsecase;
+ tree var;
+ stmtblock_t thenblock;
+ stmtblock_t elseblock;
gfc_expr *ubound;
gfc_se se;
int n;
tmp = gfc_conv_descriptor_dtype (descriptor);
gfc_add_modify_expr (pblock, tmp, gfc_get_dtype (TREE_TYPE (descriptor)));
+ or_expr = NULL_TREE;
+
for (n = 0; n < rank; n++)
{
/* We have 3 possibilities for determining the size of the array:
/* Calculate the size of this dimension. */
size = fold_build2 (PLUS_EXPR, gfc_array_index_type, se.expr, size);
+ /* Check wether the size for this dimension is negative. */
+ cond = fold_build2 (LE_EXPR, boolean_type_node, size,
+ gfc_index_zero_node);
+ if (n == 0)
+ or_expr = cond;
+ else
+ or_expr = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, or_expr, cond);
+
/* Multiply the stride by the number of elements in this dimension. */
stride = fold_build2 (MULT_EXPR, gfc_array_index_type, stride, size);
stride = gfc_evaluate_now (stride, pblock);
*poffset = offset;
}
- size = gfc_evaluate_now (size, pblock);
- return size;
+ var = gfc_create_var (TREE_TYPE (size), "size");
+ gfc_start_block (&thenblock);
+ gfc_add_modify_expr (&thenblock, var, gfc_index_zero_node);
+ thencase = gfc_finish_block (&thenblock);
+
+ gfc_start_block (&elseblock);
+ gfc_add_modify_expr (&elseblock, var, size);
+ elsecase = gfc_finish_block (&elseblock);
+
+ tmp = gfc_evaluate_now (or_expr, pblock);
+ tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
+ gfc_add_expr_to_block (pblock, tmp);
+
+ return var;
}
--- /dev/null
+! { dg-do run }
+program main
+ implicit none
+ real, allocatable :: a(:), b(:,:)
+ integer :: n,m
+ character (len=2) :: one, two
+
+ one = ' 1'
+ two = ' 2'
+
+ allocate (a(1:-1))
+ if (size(a) /= 0) call abort
+ deallocate (a)
+
+ allocate (b(1:-1,0:10))
+ if (size(b) /= 0) call abort
+ deallocate (b)
+
+ ! Use variables for array bounds. The internal reads
+ ! are there to hide fact that these are actually constant.
+
+ read (unit=one, fmt='(I2)') n
+ allocate (a(n:-1))
+ if (size(a) /= 0) call abort
+ deallocate (a)
+
+ read (unit=two, fmt='(I2)') m
+ allocate (b(1:3, m:0))
+ if (size(b) /= 0) call abort
+ deallocate (b)
+end program main