This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, Fortran] PR33139 - fix bounds for whole-array pointer assigments
- From: Tobias Burnus <burnus at net-b dot de>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>
- Date: Fri, 24 Aug 2007 16:42:52 +0200
- Subject: [Patch, Fortran] PR33139 - fix bounds for whole-array pointer assigments
:ADDPATCH fortran:
gfortran wrongly had for
pointer => array
the bounds (1:) instead of (lbound(array):). Only for array sections the
bound starts always at 1:
print *, lbound(array(:), dim=1)
prints 1.
See also:
"7.4.2.1 Data pointer assignment"
"If no bounds-remapping-list is specified, the extent of a dimension of
data-pointer-object is the extent of the corresponding dimension of
data-target. [...] the lower bound of each dimension is the result of the
intrinsic function LBOUND (13.7.60) applied to the corresponding dimension of
data-target. The upper bound of each dimension is one less than the sum of the
lower bound and the extent."
Regression tested on x86-64. Ok for the trunk?
Tobias
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.
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (Revision 127759)
+++ gcc/fortran/trans-array.c (Arbeitskopie)
@@ -4712,7 +4712,10 @@ gfc_conv_expr_descriptor (gfc_se * se, g
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, g
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, g
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, g
}
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);
Index: gcc/testsuite/gfortran.dg/shape_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/shape_2.f90 (Revision 127759)
+++ gcc/testsuite/gfortran.dg/shape_2.f90 (Arbeitskopie)
@@ -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
Index: gcc/testsuite/gfortran.dg/char_result_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_result_4.f90 (Revision 127759)
+++ gcc/testsuite/gfortran.dg/char_result_4.f90 (Arbeitskopie)
@@ -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
Index: gcc/testsuite/gfortran.dg/pointer_assign_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pointer_assign_4.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/pointer_assign_4.f90 (Revision 0)
@@ -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