re PR fortran/41113 (spurious _gfortran_internal_pack)

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

	PR fortran/41113
	PR fortran/41117
	* trans-array.c (gfc_conv_array_parameter): Use
	gfc_full_array_ref_p to detect full and contiguous variable
	arrays. Full array components and contiguous arrays do not need
	internal_pack and internal_unpack.

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

	PR fortran/41113
	PR fortran/41117
	* gfortran.dg/internal_pack_6.f90: New test.

From-SVN: r156749

gcc/fortran/ChangeLog

@@ -1,3 +1,12 @@
+2010-02-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41113
+	PR fortran/41117
+	* trans-array.c (gfc_conv_array_parameter): Use
+	gfc_full_array_ref_p to detect full and contiguous variable
+	arrays. Full array components and contiguous arrays do not need
+	internal_pack and internal_unpack.
+
 2010-02-11  Jakub Jelinek  <jakub@redhat.com>
 
 	PR fortran/43030

gcc/fortran/trans-array.c

@@ -5468,17 +5468,27 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
   tree tmp = NULL_TREE;
   tree stmt;
   tree parent = DECL_CONTEXT (current_function_decl);
-  bool full_array_var, this_array_result;
+  bool full_array_var;
+  bool this_array_result;
+  bool contiguous;
   gfc_symbol *sym;
   stmtblock_t block;
+  gfc_ref *ref;
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->next == NULL)
+      break;
+
+  full_array_var = false;
+  contiguous = false;
+
+  if (expr->expr_type == EXPR_VARIABLE && ref)
+    full_array_var = gfc_full_array_ref_p (ref, &contiguous);
 
-  full_array_var = (expr->expr_type == EXPR_VARIABLE
-		    && expr->ref->type == REF_ARRAY
-		    && expr->ref->u.ar.type == AR_FULL);
   sym = full_array_var ? expr->symtree->n.sym : NULL;
 
   /* The symbol should have an array specification.  */
-  gcc_assert (!sym || sym->as);
+  gcc_assert (!sym || sym->as || ref->u.ar.as);
 
   if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER)
     {
@@ -5501,6 +5511,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
 
       if (sym->ts.type == BT_CHARACTER)
 	se->string_length = sym->ts.u.cl->backend_decl;
+
+      if (sym->ts.type == BT_DERIVED && !sym->as)
+	{
+	  gfc_conv_expr_descriptor (se, expr, ss);
+	  se->expr = gfc_conv_array_data (se->expr);
+	  return;
+	}
+
       if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE 
           && !sym->attr.allocatable)
         {
@@ -5514,6 +5532,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
 	    array_parameter_size (tmp, expr, size);
 	  return;
         }
+
       if (sym->attr.allocatable)
         {
 	  if (sym->attr.dummy || sym->attr.result)
@@ -5528,6 +5547,18 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77,
         }
     }
 
+  if (contiguous && g77 && !this_array_result
+	&& !expr->symtree->n.sym->attr.dummy)
+    {
+      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;
+    }
+
   if (this_array_result)
     {
       /* Result of the enclosing function.  */

gcc/testsuite/ChangeLog

@@ -1,3 +1,9 @@
+2010-02-13  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/41113
+	PR fortran/41117
+	* gfortran.dg/internal_pack_6.f90: New test.
+
 2010-02-12  Jason Merrill  <jason@redhat.com>
 
 	PR c++/43054

gcc/testsuite/gfortran.dg/internal_pack_6.f90

@@ -0,0 +1,57 @@
+! { dg-do run }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR41113 and PR41117, in which unnecessary calls
+! to internal_pack and internal_unpack were being generated.
+!
+! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+!!
+MODULE M1
+ TYPE T1
+   REAL :: data(10) = [(i, i = 1, 10)]
+ END TYPE T1
+CONTAINS
+ SUBROUTINE S1(data, i, chksum)
+   REAL, DIMENSION(*) :: data
+   integer :: i, j
+   real :: subsum, chksum
+   subsum = 0
+   do j = 1, i
+     subsum = subsum + data(j)
+   end do
+   if (abs(subsum - chksum) > 1e-6) call abort
+ END SUBROUTINE S1
+END MODULE
+
+SUBROUTINE S2
+ use m1
+ TYPE(T1) :: d
+
+ real :: data1(10) = [(i, i = 1, 10)]
+ REAL :: data(-4:5,-4:5) = reshape ([(real(i), i = 1, 100)], [10,10])
+
+! PR41113
+ CALL S1(d%data, 10, sum (d%data))
+ CALL S1(data1, 10, sum (data1))
+
+! PR41117
+ DO i=-4,5
+    CALL S1(data(:,i), 10, sum (data(:,i)))
+ ENDDO
+! Being non-contiguous, this is the only time that _internal_pack is called
+ DO i=-4,5
+    CALL S1(data(-2:,i), 8, sum (data(-2:,i)))
+ ENDDO
+ DO i=-4,4
+    CALL S1(data(:,i:i+1), 20, sum (reshape (data(:,i:i+1), [20])))
+ ENDDO
+ DO i=-4,5
+    CALL S1(data(2,i), 1, data(2,i))
+ ENDDO
+END SUBROUTINE S2
+
+ call s2
+end
+! { dg-final { cleanup-modules "M1" } }
+! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 1 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }