2006-06-15 Thomas Koenig <Thomas.Koenig@online.de>

	* trans-array.h (gfc_trans_create_temp_array):  Add bool
	argument.
	* trans-arrray.c (gfc_trans_create_temp_array): Add extra
	argument "function" to show if we are translating a function.
	If we are translating a function, perform checks whether
	the size along any argument is negative.  In that case,
	allocate size 0.
	(gfc_trans_allocate_storage):  Add function argument (as
	false) to gfc_trans_create_temp_array call.
	* trans-expr.c (gfc_conv_function_call):  Add function
	argument (as true) to gfc_trans_create_temp_array call.
	* trans-stmt.c (gfc_conv_elemental_dependencies): Add
	function argument (as false) to gfc_trans_create_temp_array
	call.
	* trans-intrinsic.c:  Likewise.

2006-06-15  Thomas Koenig <Thomas.Koenig@online.de>

	* gfortran.dg/allocate_zerosize_2.f90:  New test case.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@114677 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c68fd8c..d94a748 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2006-06-15  Thomas Koenig <Thomas.Koenig@online.de>
+
+       * trans-array.h (gfc_trans_create_temp_array):  Add bool
+       argument.
+       * trans-arrray.c (gfc_trans_create_temp_array): Add extra
+       argument "function" to show if we are translating a function.
+       If we are translating a function, perform checks whether
+       the size along any argument is negative.  In that case,
+       allocate size 0.
+       (gfc_trans_allocate_storage):  Add function argument (as
+       false) to gfc_trans_create_temp_array call.
+       * trans-expr.c (gfc_conv_function_call):  Add function
+       argument (as true) to gfc_trans_create_temp_array call.
+       * trans-stmt.c (gfc_conv_elemental_dependencies): Add
+       function argument (as false) to gfc_trans_create_temp_array
+       call.
+       * trans-intrinsic.c:  Likewise.
+
 2006-06-10  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/24558

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index e3719a8..a8a8aa6 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -575,13 +575,20 @@ tree
 gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
                             gfc_loopinfo * loop, gfc_ss_info * info,
                             tree eltype, bool dynamic, bool dealloc,
-                            bool callee_alloc)
+                            bool callee_alloc, bool function)
 {
   tree type;
   tree desc;
   tree tmp;
   tree size;
   tree nelem;
+  tree cond;
+  tree or_expr;
+  tree thencase;
+  tree elsecase;
+  tree var;
+  stmtblock_t thenblock;
+  stmtblock_t elseblock;
   int n;
   int dim;
 
@@ -633,6 +640,8 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
      size = size * sizeof(element);
   */
 
+  or_expr = NULL_TREE;
+
   for (n = 0; n < info->dimen; n++)
     {
       if (loop->to[n] == NULL_TREE)
@@ -660,17 +669,55 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
       tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
                         loop->to[n], gfc_index_one_node);
 
+      if (function)
+       {
+         /* Check wether the size for this dimension is negative.  */
+         cond = fold_build2 (LE_EXPR, boolean_type_node, tmp,
+                         gfc_index_zero_node);
+
+         cond = gfc_evaluate_now (cond, pre);
+
+         if (n == 0)
+           or_expr = cond;
+         else
+           or_expr = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, or_expr, cond);
+       }
       size = fold_build2 (MULT_EXPR, gfc_array_index_type, size, tmp);
       size = gfc_evaluate_now (size, pre);
     }
 
   /* Get the size of the array.  */
-  nelem = size;
+
   if (size && !callee_alloc)
-    size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
-                       TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+    {
+      if (function)
+       {
+         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, pre);
+         tmp = build3_v (COND_EXPR, tmp, thencase, elsecase);
+         gfc_add_expr_to_block (pre, tmp);
+         nelem = var;
+         size = var;
+       }
+      else
+         nelem = size;
+
+      size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
+                         TYPE_SIZE_UNIT (gfc_get_element_type (type)));
+    }
   else
-    size = NULL_TREE;
+    {
+      nelem = size;
+      size = NULL_TREE;
+    }
 
   gfc_trans_allocate_array_storage (pre, post, info, size, nelem, dynamic,
                                    dealloc);
@@ -1421,7 +1468,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
     }
 
   gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
-                              type, dynamic, true, false);
+                              type, dynamic, true, false, false);
 
   desc = ss->data.info.descriptor;
   offset = gfc_index_zero_node;
@@ -2890,7 +2937,7 @@ gfc_conv_loop_setup (gfc_loopinfo * loop)
       loop->temp_ss->data.info.dimen = n;
       gfc_trans_create_temp_array (&loop->pre, &loop->post, loop,
                                   &loop->temp_ss->data.info, tmp, false, true,
-                                  false);
+                                  false, false);
     }
 
   for (n = 0; n < loop->temp_dim; n++)

diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index ae08534..29ccffd 100644 (file)
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -32,7 +32,7 @@ void gfc_set_loop_bounds_from_array_spec (gfc_interface_mapping *,
 
 /* Generate code to create a temporary array.  */
 tree gfc_trans_create_temp_array (stmtblock_t *, stmtblock_t *, gfc_loopinfo *,
-                                  gfc_ss_info *, tree, bool, bool, bool);
+                                  gfc_ss_info *, tree, bool, bool, bool, bool);
 
 /* Generate function entry code for allocation of compiler allocated array
    variables.  */

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 44143d1..c99372a 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2042,7 +2042,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
             mustn't be deallocated.  */
          callee_alloc = sym->attr.allocatable || sym->attr.pointer;
          gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
-                                      false, !sym->attr.pointer, callee_alloc);
+                                      false, !sym->attr.pointer, callee_alloc,
+                                      true);
 
          /* Pass the temporary as the first argument.  */
          tmp = info->descriptor;

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index e8fe286..9d6a0b7 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2712,7 +2712,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
      data field.  This is already allocated so set callee_alloc.  */
   tmp = gfc_typenode_for_spec (&expr->ts);
   gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
-                              info, tmp, false, true, false);
+                              info, tmp, false, true, false, false);
 
   /* Use memcpy to do the transfer.  */
   tmp = gfc_conv_descriptor_data_get (info->descriptor);

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index ef7d680..2a5d100 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -270,7 +270,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
          tmp = gfc_typenode_for_spec (&e->ts);
          tmp = gfc_trans_create_temp_array (&se->pre, &se->post,
                                              &tmp_loop, info, tmp,
-                                             false, true, false);
+                                             false, true, false, false);
          gfc_add_modify_expr (&se->pre, size, tmp);
          tmp = fold_convert (pvoid_type_node, info->data);
          gfc_add_modify_expr (&se->pre, data, tmp);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7f16d28..c538d13 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2006-06-15  Thomas Koenig <Thomas.Koenig@online.de>
+
+       * gfortran.dg/allocate_zerosize_2.f90:  New test case.
+
 2006-06-15  Zdenek Dvorak <dvorakz@suse.cz>
 
        * gcc.dg/tree-ssa/loop-18.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/allocate_zerosize_2.f90 b/gcc/testsuite/gfortran.dg/allocate_zerosize_2.f90
new file mode 100644 (file)
index 0000000..bd6d299
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_zerosize_2.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR 27980 - We used to allocate negative amounts of memory
+!            for functions returning arrays if lbound > ubound-1.
+!            Based on a test case by beliavsky@aol.com posted to
+!            comp.lang.fortran.
+program xint_func
+  implicit none
+  integer, parameter :: n=3,ii(n)=(/2,0,-1/)
+  integer            :: i
+  character(len=80)  :: line
+  do i=1,n
+     write (line,'(10I5)') int_func(ii(i))
+  end do
+contains
+  function int_func(n) result(ivec)
+    integer, intent(in) :: n
+    integer             :: ivec(n)
+    integer             :: i
+    if (n > 0) then
+       forall (i=1:n) ivec(i) = i
+    end if
+  end function int_func
+end program xint_func