From: tkoenig Date: Sun, 16 Apr 2006 20:29:24 +0000 (+0000) Subject: 2006-04-16 Thomas Koenig X-Git-Tag: upstream/4.9.2~54940 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=3baa29e94f5db3160fdd13b21efd20fb0c4483d4;p=platform%2Fupstream%2Flinaro-gcc.git 2006-04-16 Thomas Koenig 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 Thomas Koenig * gfortran.dg/allocate_zerosize_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@112988 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 24af5f6..05e25db7 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2006-04-16 Thomas Koenig + + 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 PR fortran/26822 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index fe8d13c..0157e62 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -2939,6 +2939,13 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, 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; @@ -2952,6 +2959,8 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, 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: @@ -3005,6 +3014,14 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, /* 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); @@ -3021,8 +3038,20 @@ gfc_array_init_size (tree descriptor, int rank, tree * poffset, *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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8aa7f67..dc960cf 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-04-16 Thomas Koenig + + * gfortran.dg/allocate_zerosize_1.f90: New test. + + 2006-04-16 Mark Mitchell PR c++/26365 diff --git a/gcc/testsuite/gfortran.dg/allocate_zerosize_1.f90 b/gcc/testsuite/gfortran.dg/allocate_zerosize_1.f90 new file mode 100644 index 0000000..c482ea0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_zerosize_1.f90 @@ -0,0 +1,31 @@ +! { 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