Re: [Bug fortran/43243] [4.5 Regression] Missing array temp for DT with pointer component

[Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>]

Yet another in the series :-)   I hope that it is the last...

This bootstraps and regtests on RHEL5.2/x86_64 - OK for trunk?

Paul

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

	PR fortran/43243
	* trans-array.c (gfc_conv_array_parameter): Contiguous refs to
	allocatable ultimate components do not need temporaries, whilst
	ultimate pointer components do.

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

	PR fortran/43243
	* gfortran.dg/internal_pack_12.f90: New test.

Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c	(revision 157163)
+++ gcc/fortran/trans-array.c	(working copy)
@@ -5474,18 +5474,30 @@
   bool no_pack;
   bool array_constructor;
   bool good_allocatable;
+  bool ultimate_ptr_comp;
+  bool ultimate_alloc_comp;
   gfc_symbol *sym;
   stmtblock_t block;
   gfc_ref *ref;
 
+  ultimate_ptr_comp = false;
+  ultimate_alloc_comp = false;
   for (ref = expr->ref; ref; ref = ref->next)
-    if (ref->next == NULL)
-      break;
+    {
+      if (ref->next == NULL)
+        break;
 
+      if (ref->type == REF_COMPONENT)
+	{
+	  ultimate_ptr_comp = ref->u.c.component->attr.pointer;
+	  ultimate_alloc_comp = ref->u.c.component->attr.allocatable;
+	}
+    }
+
   full_array_var = false;
   contiguous = false;
 
-  if (expr->expr_type == EXPR_VARIABLE && ref)
+  if (expr->expr_type == EXPR_VARIABLE && ref && !ultimate_ptr_comp)
     full_array_var = gfc_full_array_ref_p (ref, &contiguous);
 
   sym = full_array_var ? expr->symtree->n.sym : NULL;
@@ -5552,6 +5564,9 @@
         }
     }
 
+  /* A convenient reduction in scope.  */
+  contiguous = g77 && !this_array_result && contiguous;
+
   /* 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
@@ -5563,17 +5578,20 @@
 		  && ref->u.ar.as->type != AS_DEFERRED
 		  && ref->u.ar.as->type != AS_ASSUMED_SHAPE));
 
-  no_pack = g77 && !this_array_result && contiguous && no_pack;
+  no_pack = contiguous && no_pack;
 
   /* 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);
+  good_allocatable = contiguous
+		       && expr->symtree
+		       && expr->symtree->n.sym->attr.allocatable;
 
-  if (no_pack || array_constructor || good_allocatable)
+  /* Or ultimate allocatable components.  */
+  ultimate_alloc_comp = contiguous && ultimate_alloc_comp; 
+
+  if (no_pack || array_constructor || good_allocatable || ultimate_alloc_comp)
     {
       gfc_conv_expr_descriptor (se, expr, ss);
       if (expr->ts.type == BT_CHARACTER)
Index: gcc/testsuite/gfortran.dg/internal_pack_12.f90
===================================================================
--- gcc/testsuite/gfortran.dg/internal_pack_12.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/internal_pack_12.f90	(revision 0)
@@ -0,0 +1,61 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! Test the fix for PR43243, where unnecessary calls to internal_pack/unpack
+! were being produced below. These references are contiguous and so do not
+! need a temporary. In addition, the final call to 'bar' required a pack/unpack
+! which had been missing since r156680, at least.
+!
+! Contributed Tobias Burnus <burnus@gcc.gnu.org>
+!
+module m
+  type t
+    integer, allocatable :: a(:)
+    integer, pointer :: b(:)
+    integer :: c(5)
+  end type t
+end module m
+
+subroutine foo(a,d,e,n)
+  use m
+  implicit none
+  integer :: n
+  type(t) :: a
+  type(t), allocatable :: d(:)
+  type(t), pointer :: e(:)
+  call bar(   a%a) ! OK - no array temp needed
+  call bar(   a%c) ! OK - no array temp needed
+
+  call bar(   a%a(1:n)) ! Missed: No pack needed
+  call bar(   a%b(1:n)) ! OK: pack needed
+  call bar(   a%c(1:n)) ! Missed: No pack needed
+
+  call bar(d(1)%a(1:n)) ! Missed: No pack needed
+  call bar(d(1)%b(1:n)) ! OK: pack needed
+  call bar(d(1)%c(1:n)) ! Missed: No pack needed
+
+  call bar(e(1)%a(1:n)) ! Missed: No pack needed
+  call bar(e(1)%b(1:n)) ! OK: pack needed
+  call bar(e(1)%c(1:n)) ! Missed: No pack needed
+end subroutine foo
+
+use m
+implicit none
+integer :: i
+integer, target :: z(6)
+type(t) :: y
+
+z = [(i, i=1,6)]
+y%b => z(::2)
+call bar(y%b)  ! Missed: Pack needed
+end
+
+subroutine bar(x)
+  integer :: x(1:*)
+  print *, x(1:3)
+  if (any (x(1:3) /= [1,3,5])) call abort ()
+end subroutine bar
+! { dg-final { scan-tree-dump-times "unpack" 4 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }
+! { dg-final { cleanup-modules "m" } }
+