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);
}
--- /dev/null
+! { 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
+! Clive Page <clivegpage@googlemail.com>\r
+! and Mikael Morin <mikael.morin@tele2.fr>\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
+ interface\r
+ SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)\r
+ INTEGER IDA(4)\r
+ REAL DDA(5,5,5,5,5)\r
+ TARGET DDA\r
+ END SUBROUTINE\r
+ end interface\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
+ call mikael ! http://gcc.gnu.org/ml/fortran/2009-01/msg00342.html\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
+\r
+subroutine mikael\r
+ implicit none\r
+ call test (1, 3, 3)\r
+ call test (2, 3, 3)\r
+ call test (2, -1, 0)\r
+ call test (1, -1, 0)\r
+contains\r
+ subroutine test (a, b, expect)\r
+ integer :: a, b, expect\r
+ integer :: c(a:b)\r
+ if (ubound (c, 1) .ne. expect) call abort\r
+ end subroutine test\r
+end subroutine\r