PR fortran/30720

	* trans-array.c (gfc_trans_create_temp_array): Remove use of the
	function argument. Always generate code for negative extent.
	Simplify said code.
	* trans-array.h (gfc_trans_create_temp_array): Change prototype.
	* trans-expr.c (gfc_conv_function_call): Remove use of last argument
	of gfc_trans_create_temp_array.
	* trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Likewise.
	* trans-stmt.c (gfc_conv_elemental_dependencies): Likewise.

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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 59636db..e501db6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2007-02-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR fortran/30720
+       * trans-array.c (gfc_trans_create_temp_array): Remove use of the
+       function argument. Always generate code for negative extent.
+       Simplify said code.
+       * trans-array.h (gfc_trans_create_temp_array): Change prototype.
+       * trans-expr.c (gfc_conv_function_call): Remove use of last argument
+       of gfc_trans_create_temp_array.
+       * trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Likewise.
+       * trans-stmt.c (gfc_conv_elemental_dependencies): Likewise.
+
 2007-02-08  Roger Sayle  <roger@eyesopen.com>
 
        * trans-stmt.c (gfc_trans_forall_1): Optimize the cases where the

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index a39f664..1c89975 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -583,7 +583,7 @@ 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 function)
+                            bool callee_alloc)
 {
   tree type;
   tree desc;
@@ -592,11 +592,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
   tree nelem;
   tree cond;
   tree or_expr;
-  tree thencase;
-  tree elsecase;
-  tree var;
-  stmtblock_t thenblock;
-  stmtblock_t elseblock;
   int n;
   int dim;
 
@@ -678,19 +673,16 @@ 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 whether the size for this dimension is negative.  */
-         cond = fold_build2 (LE_EXPR, boolean_type_node, tmp,
+      /* Check whether 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);
 
-         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);
 
-         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);
     }
@@ -699,33 +691,10 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post,
 
   if (size && !callee_alloc)
     {
-      if (function)
-       {
-         /* If we know at compile-time whether any dimension size is
-            negative, we can avoid a conditional and pass the true size
-            to gfc_trans_allocate_array_storage, which can then decide
-            whether to allocate this on the heap or on the stack.  */
-         if (integer_zerop (or_expr))
-           ;
-         else if (integer_onep (or_expr))
-           size = gfc_index_zero_node;
-         else
-           {
-             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);
-             size = var;
-           }
-       }
+      /* If or_expr is true, then the extent in at least one
+        dimension is zero and the size is set to zero.  */
+      size = fold_build3 (COND_EXPR, gfc_array_index_type,
+                         or_expr, gfc_index_zero_node, size);
 
       nelem = size;
       size = fold_build2 (MULT_EXPR, gfc_array_index_type, size,
@@ -1647,7 +1616,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, false);
+                              type, dynamic, true, false);
 
   desc = ss->data.info.descriptor;
   offset = gfc_index_zero_node;
@@ -3241,7 +3210,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 278ea1e..d3f4e5f 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, bool);
+                                  gfc_ss_info *, tree, 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 723ffab..1a97e31 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2332,8 +2332,7 @@ 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,
-                                      true);
+                                      false, !sym->attr.pointer, callee_alloc);
 
          /* 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 aa8008b..5ad0f38 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2975,10 +2975,12 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
   se->loop->to[n] = upper;
 
   /* Build a destination descriptor, using the pointer, source, as the
-     data field.  This is already allocated so set callee_alloc.  */
+     data field.  This is already allocated so set callee_alloc.
+     FIXME callee_alloc is not set!  */
+ 
   tmp = gfc_typenode_for_spec (&expr->ts);
   gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
-                              info, tmp, false, true, false, false);
+                              info, tmp, false, true, 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 db92c02..6b8a9a0 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -268,7 +268,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);
+                                             false, true, 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 4d65bf4..1570d3e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-02-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR fortran/30720
+       * gfortran.dg/array_function_1.f90: New test.
+
 2007-02-09  Richard Sandiford  <richard@codesourcery.com>
 
        * lib/target-supports.exp (check_effective_target_lax_strtofp)
@@ -161,7 +166,7 @@
 2007-02-04  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
 
        PR fortran/30611
-       * gcc/testsuite/gfortran.dg/repeat_1.f90: New test.
+       * gfortran.dg/repeat_1.f90: New test.
 
 2007-02-04  Steven G. Kargl <kargl@gcc.gnu.org>
 

diff --git a/gcc/testsuite/gfortran.dg/array_function_1.f90 b/gcc/testsuite/gfortran.dg/array_function_1.f90
new file mode 100644 (file)
index 0000000..281ae88
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_function_1.f90
@@ -0,0 +1,27 @@
+! { dg-do run }
+! PR fortran/30720
+program array_function_1
+  integer :: a(5), b, l, u
+  l = 4
+  u = 2
+
+  a = (/ 1, 2, 3, 4, 5 /)
+
+  b = f(a(l:u) - 2)
+  if (b /= 0) call abort
+
+  b = f(a(4:2) - 2)
+  if (b /= 0) call abort
+
+  b = f(a(u:l) - 2)
+  if (b /= 3) call abort
+
+  b = f(a(2:4) - 2)
+  if (b /= 3) call abort
+
+  contains
+    integer function f(x)
+      integer, dimension(:), intent(in) :: x
+      f = sum(x)
+    end function
+end program