1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
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
|
