re PR fortran/38852 ([4.3] UBOUND fails for negative stride triplets)

2009-02-19  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-02-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38852
	PR fortran/39006
	* gfortran.dg/bound_6.f90: New test.

From-SVN: r144286

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 398405eeb4e112c2089b0ef2f20a9ae9c5dd2cfc..993d7e47b84aed3f06aecef9bc377af1cb624db8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/38852
+       PR fortran/39006
+       Backport from trunk
+       * trans-intrinsic.c (gfc_conv_intrinsic_bound): Use the array
+       descriptor ubound for UBOUND, when the array lbound == 1.
+
 2009-01-26  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/38907

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 2c287c9752433c25bc0bed23f06310e7f5d4fa9b..8e89989744f1b451ec6cda1167b757f72eddb513 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -917,12 +917,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 21b482e742c59ef00892d90386b9228508a5ea03..2a9ceeba4605268e3eeebb526148142bdeaec6db 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2009-02-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/38852
+       PR fortran/39006
+       Backport from mainline:
+       * gfortran.dg/bound_6.f90: New test.
+
 2009-02-17  Jason Merrill  <jason@redhat.com>
 
        PR c++/38950

diff --git a/gcc/testsuite/gfortran.dg/bound_6.f90 b/gcc/testsuite/gfortran.dg/bound_6.f90
new file mode 100644 (file)
index 0000000..de1a5e1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bound_6.f90
@@ -0,0 +1,48 @@
+! { dg-do run }\r
+! Test the fix for PR38852 and PR39006 in which LBOUND did not work\r
+! for some arrays with negative strides.\r
+!\r
+! Contributed by Dick Hendrickson  <dick.hendrickson@gmail.com>\r
+! and Clive Page <clivegpage@googlemail.com>\r
+!\r
+program try_je0031\r
+  integer ida(4)\r
+  real dda(5,5,5,5,5)\r
+  integer, parameter :: nx = 4, ny = 3\r
+  integer :: array1(nx,ny), array2(nx,ny) \r
+  data array2 / 1,2,3,4, 10,20,30,40, 100,200,300,400 /\r
+  array1 = array2\r
+  call PR38852(IDA,DDA,2,5,-2)\r
+  call PR39006(array1, array2(:,ny:1:-1))\r
+contains\r
+  subroutine PR39006(array1, array2)\r
+    integer, intent(in) :: array1(:,:), array2(:,:)\r
+    integer :: j\r
+    do j = 1, ubound(array2,2)\r
+      if (any (array1(:,j) .ne. array2(:,4-j))) call abort\r
+    end do\r
+  end subroutine\r
+end \r
+\r
+SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)\r
+  INTEGER IDA(4)\r
+  REAL DLA(:,:,:,:)\r
+  REAL DDA(5,5,5,5,5)\r
+  POINTER DLA\r
+  TARGET DDA\r
+  DLA => DDA(2:3, 1:3:2, 5:4:-1, NF2, NF5:NF2:MF2)\r
+  IDA = UBOUND(DLA)\r
+  if (any(ida /= 2)) call abort\r
+  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)\r
+  IDA = UBOUND(DLA)\r
+  if (any(ida /= 2)) call abort\r
+!\r
+! These worked.\r
+!\r
+  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)\r
+  IDA = shape(DLA)\r
+  if (any(ida /= 2)) call abort\r
+  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)\r
+  IDA = LBOUND(DLA)\r
+  if (any(ida /= 1)) call abort\r
+END SUBROUTINE\r