re PR fortran/26017 (allocate (a(1:-1)) should yield zero-sized array)
authorThomas Koenig <Thomas.Koenig@online.de>
Sun, 16 Apr 2006 20:29:24 +0000 (20:29 +0000)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 16 Apr 2006 20:29:24 +0000 (20:29 +0000)
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  Thomas Koenig  <Thomas.Koenig@online.de>

        * gfortran.dg/allocate_zerosize_1.f90:  New test.

From-SVN: r112988

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/allocate_zerosize_1.f90 [new file with mode: 0644]

index 24af5f628808d6798309bd85b509b0ad5dc6de28..05e25db75502f0290c7320260a51db9592047630 100644 (file)
@@ -1,3 +1,12 @@
+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
index fe8d13ca76e05b9e868827108cc1e00d216f85f0..0157e62cb8792e91631f8a3a3ef3e666248cbee8 100644 (file)
@@ -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;
 }
 
 
index 8aa7f6793e73421b543864c972efdd5364af8030..dc960cfa72105ac40787f5824d7f8bb9f2c81cde 100644 (file)
@@ -1,3 +1,8 @@
+2006-04-16  Thomas Koenig  <Thomas.Koenig@online.de>
+
+        * gfortran.dg/allocate_zerosize_1.f90:  New test.
+
+
 2006-04-16  Mark Mitchell  <mark@codesourcery.com>
 
        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 (file)
index 0000000..c482ea0
--- /dev/null
@@ -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