re PR fortran/38852 ([4.3] UBOUND fails for negative stride triplets)
2009-01-28 Paul Thomas <pault@gcc.gnu.org> PR fortran/38852 PR fortran/39006 * trans-intrinsic.c (gfc_conv_intrinsic_bound): Use the array descriptor ubound for UBOUND, when the array lbound == 1. 2009-01-28 Paul Thomas <pault@gcc.gnu.org> PR fortran/38852 PR fortran/39006 * gfortran.dg/bound_6.f90: New test. From-SVN: r143743
This commit is contained in:
parent
001b9eb6b1
commit
61a3961538
|
@ -1,3 +1,10 @@
|
|||
2009-01-28 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/38852
|
||||
PR fortran/39006
|
||||
* trans-intrinsic.c (gfc_conv_intrinsic_bound): Use the array
|
||||
descriptor ubound for UBOUND, when the array lbound == 1.
|
||||
|
||||
2009-01-27 Daniel Kraft <d@domob.eu>
|
||||
|
||||
PR fortran/38883
|
||||
|
|
|
@ -972,12 +972,17 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
|
|||
|
||||
cond4 = fold_build2 (LT_EXPR, boolean_type_node, stride,
|
||||
gfc_index_zero_node);
|
||||
cond4 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond4, cond2);
|
||||
|
||||
if (upper)
|
||||
{
|
||||
tree cond5;
|
||||
cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond3, cond4);
|
||||
|
||||
cond5 = fold_build2 (EQ_EXPR, boolean_type_node, gfc_index_one_node, lbound);
|
||||
cond5 = fold_build2 (TRUTH_AND_EXPR, boolean_type_node, cond4, cond5);
|
||||
|
||||
cond = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, cond, cond5);
|
||||
|
||||
se->expr = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
|
||||
ubound, gfc_index_zero_node);
|
||||
}
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2009-01-28 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/38852
|
||||
PR fortran/39006
|
||||
* gfortran.dg/bound_6.f90: New test.
|
||||
|
||||
2009-01-28 Pat Haugen <pthaugen@us.ibm.com>
|
||||
|
||||
* gcc.target/powerpc/avoid-indexed-addresses.c: New test.
|
||||
|
|
|
@ -0,0 +1,71 @@
|
|||
! { dg-do run }
|
||||
! Test the fix for PR38852 and PR39006 in which LBOUND did not work
|
||||
! for some arrays with negative strides.
|
||||
!
|
||||
! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
|
||||
! Clive Page <clivegpage@googlemail.com>
|
||||
! and Mikael Morin <mikael.morin@tele2.fr>
|
||||
!
|
||||
program try_je0031
|
||||
integer ida(4)
|
||||
real dda(5,5,5,5,5)
|
||||
integer, parameter :: nx = 4, ny = 3
|
||||
interface
|
||||
SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)
|
||||
INTEGER IDA(4)
|
||||
REAL DDA(5,5,5,5,5)
|
||||
TARGET DDA
|
||||
END SUBROUTINE
|
||||
end interface
|
||||
integer :: array1(nx,ny), array2(nx,ny)
|
||||
data array2 / 1,2,3,4, 10,20,30,40, 100,200,300,400 /
|
||||
array1 = array2
|
||||
call PR38852(IDA,DDA,2,5,-2)
|
||||
call PR39006(array1, array2(:,ny:1:-1))
|
||||
call mikael ! http://gcc.gnu.org/ml/fortran/2009-01/msg00342.html
|
||||
contains
|
||||
subroutine PR39006(array1, array2)
|
||||
integer, intent(in) :: array1(:,:), array2(:,:)
|
||||
integer :: j
|
||||
do j = 1, ubound(array2,2)
|
||||
if (any (array1(:,j) .ne. array2(:,4-j))) call abort
|
||||
end do
|
||||
end subroutine
|
||||
end
|
||||
|
||||
SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)
|
||||
INTEGER IDA(4)
|
||||
REAL DLA(:,:,:,:)
|
||||
REAL DDA(5,5,5,5,5)
|
||||
POINTER DLA
|
||||
TARGET DDA
|
||||
DLA => DDA(2:3, 1:3:2, 5:4:-1, NF2, NF5:NF2:MF2)
|
||||
IDA = UBOUND(DLA)
|
||||
if (any(ida /= 2)) call abort
|
||||
DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
|
||||
IDA = UBOUND(DLA)
|
||||
if (any(ida /= 2)) call abort
|
||||
!
|
||||
! These worked.
|
||||
!
|
||||
DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
|
||||
IDA = shape(DLA)
|
||||
if (any(ida /= 2)) call abort
|
||||
DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
|
||||
IDA = LBOUND(DLA)
|
||||
if (any(ida /= 1)) call abort
|
||||
END SUBROUTINE
|
||||
|
||||
subroutine mikael
|
||||
implicit none
|
||||
call test (1, 3, 3)
|
||||
call test (2, 3, 3)
|
||||
call test (2, -1, 0)
|
||||
call test (1, -1, 0)
|
||||
contains
|
||||
subroutine test (a, b, expect)
|
||||
integer :: a, b, expect
|
||||
integer :: c(a:b)
|
||||
if (ubound (c, 1) .ne. expect) call abort
|
||||
end subroutine test
|
||||
end subroutine
|
Loading…
Reference in New Issue