2007-08-24 Tobias Burnus <burnus@net-b.de>

	PR fortran/33139
	* trans-array.c (gfc_conv_expr_descriptor): Copy bounds for
	whole-array pointer assignments.

2007-08-24  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33139
	* gfortran.dg/pointer_assign_4.f90: New.
	* gfortran.dg/shape_2.f90: Fix test case.
	* gfortran.dg/char_result_4.f90: Ditto.



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

6 files changed, 96 insertions, 15 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 80111f31551..67d779181c0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2007-08-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33139
+	* trans-array.c (gfc_conv_expr_descriptor): Copy bounds for
+	whole-array pointer assignments.
+
 2007-08-23  Jakub Jelinek  <jakub@redhat.com>
 
 	* decl.c (variable_decl): Don't share charlen structs if
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index f6b4751fb7c..73a57e82c4c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -4712,7 +4712,10 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
       tmp = gfc_conv_descriptor_dtype (parm);
       gfc_add_modify_expr (&loop.pre, tmp, gfc_get_dtype (parmtype));
 
-      if (se->direct_byref)
+      /* Set offset for assignments to pointer only to zero if it is not
+         the full array.  */
+      if (se->direct_byref
+	  && info->ref && info->ref->u.ar.type != AR_FULL)
 	base = gfc_index_zero_node;
       else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
 	base = gfc_evaluate_now (gfc_conv_array_offset (desc), &loop.pre);
@@ -4763,12 +4766,11 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	  from = loop.from[dim];
 	  to = loop.to[dim];
 
-	  /* If we have an array section or are assigning to a pointer,
-	     make sure that the lower bound is 1.  References to the full
+	  /* If we have an array section or are assigning make sure that
+	     the lower bound is 1.  References to the full
 	     array should otherwise keep the original bounds.  */
 	  if ((!info->ref
-	       || info->ref->u.ar.type != AR_FULL
-	       || se->direct_byref)
+	          || info->ref->u.ar.type != AR_FULL)
 	      && !integer_onep (from))
 	    {
 	      tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
@@ -4788,7 +4790,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	  stride = fold_build2 (MULT_EXPR, gfc_array_index_type,
 				stride, info->stride[dim]);
 
-	  if (se->direct_byref)
+	  if (se->direct_byref && info->ref && info->ref->u.ar.type != AR_FULL)
 	    {
 	      base = fold_build2 (MINUS_EXPR, TREE_TYPE (base),
 				  base, stride);
@@ -4824,7 +4826,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
 	}
 
       if ((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
-	     && !se->data_not_needed)
+	  && !se->data_not_needed)
 	{
 	  /* Set the offset.  */
 	  tmp = gfc_conv_descriptor_offset (parm);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f7092ecf2cb..a27c2ad411e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2007-08-24  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33139
+	* gfortran.dg/pointer_assign_4.f90: New.
+	* gfortran.dg/shape_2.f90: Fix test case.
+	* gfortran.dg/char_result_4.f90: Ditto.
+
 2007-08-24  Jakub Jelinek  <jakub@redhat.com>
 
 	* gcc.dg/array-init-1.c: New test.
diff --git a/gcc/testsuite/gfortran.dg/char_result_4.f90 b/gcc/testsuite/gfortran.dg/char_result_4.f90
index 0224f43c0b4..5e4f58e188b 100644
--- a/gcc/testsuite/gfortran.dg/char_result_4.f90
+++ b/gcc/testsuite/gfortran.dg/char_result_4.f90
@@ -22,12 +22,12 @@ program main
 
   a = (/ (i + 5, i = 0, 4) /)
   ap => a
-  lower = 1
+  lower = lbound(a,dim=1)
 
   call test (f1 (ap), 35)
   call test (f2 (ap), 115)
   call test (f3 (ap), 60)
-  call test (f4 (ap, 5, 2), 21)
+  call test (f4 (ap, 104, 2), 21)
 contains
   function f1 (array)
     integer, dimension (:), pointer :: array
@@ -37,13 +37,13 @@ contains
 
   function f2 (array)
     integer, dimension (:), pointer :: array
-    character (len = array (2) + a (104) + 100) :: f2
+    character (len = array (101) + a (104) + 100) :: f2
     f2 = ''
   end function f2
 
   function f3 (array)
     integer, dimension (:), pointer :: array
-    character (len = sum (double (array (2:)))) :: f3
+    character (len = sum (double (array (101:)))) :: f3
     f3 = ''
   end function f3
 
diff --git a/gcc/testsuite/gfortran.dg/pointer_assign_4.f90 b/gcc/testsuite/gfortran.dg/pointer_assign_4.f90
new file mode 100644
index 00000000000..faf7c776c59
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pointer_assign_4.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+!
+! Verify that the bounds are correctly set when assigning pointers.
+!
+! PR fortran/33139
+!
+program prog
+  implicit none
+  real, target :: a(-10:10)
+  real, pointer :: p(:),p2(:)
+  integer :: i
+  do i = -10, 10
+    a(i) = real(i)
+  end do
+  p  => a
+  p2 => p
+  if((lbound(p, dim=1) /= -10) .or. (ubound(p, dim=1) /= 10)) &
+    call abort()
+  if((lbound(p2,dim=1) /= -10) .or. (ubound(p2,dim=1) /= 10)) &
+    call abort()
+  do i = -10, 10
+    if(p(i) /= real(i)) call abort()
+    if(p2(i) /= real(i)) call abort()
+  end do
+  p => a(:)
+  p2 => p
+  if((lbound(p, dim=1) /= 1) .or. (ubound(p, dim=1) /= 21)) &
+    call abort()
+  if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
+    call abort()
+  p2 => p(:)
+  if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
+    call abort()
+  call multdim()
+contains
+  subroutine multdim()
+    real, target, allocatable :: b(:,:,:)
+    real, pointer :: ptr(:,:,:)
+    integer :: i, j, k
+    allocate(b(-5:5,10:20,0:3))
+    do i = 0, 3
+      do j = 10, 20
+        do k = -5, 5
+          b(k,j,i) = real(i+10*j+100*k)
+        end do
+      end do
+    end do
+    ptr => b
+    if((lbound(ptr,dim=1) /= -5) .or. (ubound(ptr,dim=1) /=  5) .or. &
+       (lbound(ptr,dim=2) /= 10) .or. (ubound(ptr,dim=2) /= 20) .or. &
+       (lbound(ptr,dim=3) /=  0) .or. (ubound(ptr,dim=3) /=  3))     &
+      call abort()
+    do i = 0, 3
+      do j = 10, 20
+        do k = -5, 5
+          if(ptr(k,j,i) /= real(i+10*j+100*k)) call abort()
+        end do
+      end do
+    end do
+    ptr => b(:,:,:)
+    if((lbound(ptr,dim=1) /= 1) .or. (ubound(ptr,dim=1) /= 11) .or. &
+       (lbound(ptr,dim=2) /= 1) .or. (ubound(ptr,dim=2) /= 11) .or. &
+       (lbound(ptr,dim=3) /= 1) .or. (ubound(ptr,dim=3) /=  4))     &
+      call abort()
+  end subroutine multdim
+end program prog
diff --git a/gcc/testsuite/gfortran.dg/shape_2.f90 b/gcc/testsuite/gfortran.dg/shape_2.f90
index a4bde98ba5f..057cb4c8558 100644
--- a/gcc/testsuite/gfortran.dg/shape_2.f90
+++ b/gcc/testsuite/gfortran.dg/shape_2.f90
@@ -22,9 +22,9 @@ contains
     if (ubound (b (20:30:3, 40), 1) .ne. 4) call abort
 
     ptr => b
-    if (lbound (ptr, 1) .ne. 1) call abort
-    if (ubound (ptr, 1) .ne. 40) call abort
-    if (lbound (ptr, 2) .ne. 1) call abort
-    if (ubound (ptr, 2) .ne. 80) call abort
+    if (lbound (ptr, 1) .ne. 11) call abort
+    if (ubound (ptr, 1) .ne. 50) call abort
+    if (lbound (ptr, 2) .ne. -8) call abort
+    if (ubound (ptr, 2) .ne. 71) call abort
   end subroutine test
 end program main