diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2009-01-28 21:48:53 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2009-01-28 21:48:53 +0000 |
| commit | 61a3961538a6b911e8010eb68332875f61dbbf57 (patch) | |
| tree | e13e8efea1b864dfafd2a18c470041a2c15dd1b8 | |
| parent | 001b9eb6b19df30cceb3e9bddeb7fbec526ff958 (diff) | |
| download | gcc-61a3961538a6b911e8010eb68332875f61dbbf57.zip gcc-61a3961538a6b911e8010eb68332875f61dbbf57.tar.gz gcc-61a3961538a6b911e8010eb68332875f61dbbf57.tar.bz2 | |
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
| -rw-r--r-- | gcc/fortran/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 7 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/bound_6.f90 | 71 |
4 files changed, 90 insertions, 1 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6facf64d..1186064 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index e3941c5..50b4293 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -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); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 44e685b..06585cd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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. diff --git a/gcc/testsuite/gfortran.dg/bound_6.f90 b/gcc/testsuite/gfortran.dg/bound_6.f90 new file mode 100644 index 0000000..5e0e3f7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bound_6.f90 @@ -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
|