re PR fortran/33139 (array pointer assignment gives incorrect dimensions)

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.

From-SVN: r127770

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 80111f3155139f01a555d802acdf100a362bac1f..67d779181c03b0f4a232f62cedb575c65419b803 100644 (file)
--- 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 f6b4751fb7c9d0c14fcb022fdfd15a076108046b..73a57e82c4c060eebc41706ccdb95511f0bd7ad5 100644 (file)
--- 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 f7092ecf2cb10cecbceb18f7623c7a5c4308a21a..a27c2ad411ef8389fd9bd88ed3676a610d6068ee 100644 (file)
--- 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 0224f43c0b4a87a6670022e957b0c0a0df0c8549..5e4f58e188bbef7067af089a58a519e74eda71b1 100644 (file)
--- 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 (file)
index 0000000..faf7c77
--- /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 a4bde98ba5f7fc331fae86d1647df4242dceeee6..057cb4c855872966412bdb0cb8eb5de16cb7cb8e 100644 (file)
--- 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