re PR fortran/43180 (Bad results without temporary copy of intent(in) argument)

2010-03-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43180
	* trans-array.c (gfc_conv_array_parameter): A full array of
	derived type need not be restricted to a symbol without an
	array spec to use the call to gfc_conv_expr_descriptor.

	PR fortran/43173
	* trans-array.c (gfc_conv_array_parameter): Contiguous refs to
	allocatable arrays do not need temporaries.

2010-03-02  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43180
	* gfortran.dg/internal_pack_10.f90: New test.

	PR fortran/43173
	* gfortran.dg/internal_pack_11.f90: New test.

From-SVN: r157163

5 files changed, 92 insertions, 16 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 0c802b6..12c7192 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2010-03-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43180
+	* trans-array.c (gfc_conv_array_parameter): A full array of
+	derived type need not be restricted to a symbol without an
+	array spec to use the call to gfc_conv_expr_descriptor.
+
+	PR fortran/43173
+	* trans-array.c (gfc_conv_array_parameter): Contiguous refs to
+	allocatable arrays do not need temporaries.
+
 2010-03-01  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/43199
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2ea978d..c872889 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5472,6 +5472,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
   bool this_array_result;
   bool contiguous;
   bool no_pack;
+  bool array_constructor;
+  bool good_allocatable;
   gfc_symbol *sym;
   stmtblock_t block;
   gfc_ref *ref;
@@ -5513,7 +5515,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
       if (sym->ts.type == BT_CHARACTER)
 	se->string_length = sym->ts.u.cl->backend_decl;
 
-      if (sym->ts.type == BT_DERIVED && !sym->as)
+      if (sym->ts.type == BT_DERIVED)
 	{
 	  gfc_conv_expr_descriptor (se, expr, ss);
 	  se->expr = gfc_conv_array_data (se->expr);
@@ -5550,8 +5552,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
         }
     }
 
-  /* There is no need to pack and unpack the array, if it is an array
-     constructor or contiguous and not deferred or assumed shape.  */
+  /* There is no need to pack and unpack the array, if it is contiguous
+     and not deferred or assumed shape.  */
   no_pack = ((sym && sym->as
 		  && !sym->attr.pointer
 		  && sym->as->type != AS_DEFERRED
@@ -5561,21 +5563,17 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77,
 		  && ref->u.ar.as->type != AS_DEFERRED
 		  && ref->u.ar.as->type != AS_ASSUMED_SHAPE));
 
-  no_pack = g77 && !this_array_result
-		&& (expr->expr_type == EXPR_ARRAY || (contiguous && no_pack));
+  no_pack = g77 && !this_array_result && contiguous && no_pack;
 
-  if (no_pack)
-    {
-      gfc_conv_expr_descriptor (se, expr, ss);
-      if (expr->ts.type == BT_CHARACTER)
-	se->string_length = expr->ts.u.cl->backend_decl;
-      if (size)
-	array_parameter_size (se->expr, expr, size);
-      se->expr = gfc_conv_array_data (se->expr);
-      return;
-    }
+  /* Array constructors are always contiguous and do not need packing.  */
+  array_constructor = g77 && !this_array_result && expr->expr_type == EXPR_ARRAY;
+
+  /* Same is true of contiguous sections from allocatable variables.  */
+  good_allocatable = (g77 && !this_array_result && contiguous
+			&& expr->symtree
+			&& expr->symtree->n.sym->attr.allocatable);
 
-  if (expr->expr_type == EXPR_ARRAY && g77)
+  if (no_pack || array_constructor || good_allocatable)
     {
       gfc_conv_expr_descriptor (se, expr, ss);
       if (expr->ts.type == BT_CHARACTER)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 63ceb9a..2b0b742 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2010-03-02  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43180
+	* gfortran.dg/internal_pack_10.f90: New test.
+
+	PR fortran/43173
+	* gfortran.dg/internal_pack_11.f90: New test.
+
 2010-03-02  Reza Yazdani  <reza.yazdani@amd.com>
 
 	PR middle-end/42640
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_10.f90 b/gcc/testsuite/gfortran.dg/internal_pack_10.f90
new file mode 100644
index 0000000..8d972f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_10.f90
@@ -0,0 +1,41 @@
+! { dg-do run }
+! Test the fix for PR43180, in which patch which reduced the use of
+! internal_pack/unpack messed up the passing of ru(1)%c as the actual
+! argument at line 23 in this testcase.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+! further reduced by Tobias Burnus <burnus@gcc.gnu.org>
+!
+module mo_obs_rules
+  type t_set
+     integer :: use = 42
+  end type t_set
+  type t_rules
+     character(len=40) :: comment
+     type(t_set)       :: c (1)
+  end type t_rules
+  type (t_rules), save :: ru (1)
+contains
+  subroutine get_rule (c)
+    type(t_set) :: c (:)
+    ru(1)%c(:)%use = 99
+    if (any (c(:)%use .ne. 42)) call abort
+    call set_set_v (ru(1)%c, c)
+    if (any (c(:)%use .ne. 99)) call abort
+  contains
+    subroutine set_set_v (src, dst)
+      type(t_set), intent(in)    :: src(1)
+      type(t_set), intent(inout) :: dst(1)
+    if (any (src%use .ne. 99)) call abort
+    if (any (dst%use .ne. 42)) call abort
+      dst = src
+    end subroutine set_set_v
+  end subroutine get_rule
+end module mo_obs_rules
+
+program test
+  use mo_obs_rules
+  type(t_set) :: c (1)
+  call get_rule (c)
+end program test
+! { dg-final { cleanup-modules "mo_obs_rules" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_11.f90 b/gcc/testsuite/gfortran.dg/internal_pack_11.f90
new file mode 100644
index 0000000..8f573b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_11.f90
@@ -0,0 +1,18 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR43173, where unnecessary calls to internal_pack/unpack
+! were being produced below. These references are contiguous and so do not
+! need a temporary.
+!
+! Contributed Tobias Burnus <burnus@gcc.gnu.org>
+!
+  REAL, allocatable :: ot(:)
+  integer :: time_steps
+
+  call foo (ot) ! OK, no temporary
+  call foo (ot(0:5:1)) ! Was an unnecessary temporary
+  call foo (ot(0:time_steps)) ! Was an unnecessary temporary
+  end
+! { dg-final { scan-tree-dump-times "unpack" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }