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
This commit is contained in:
parent
14a43348bc
commit
a7d318ea7f
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue