OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [bound_6.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Test the fix for PR38852 and PR39006 in which LBOUND did not work
3
! for some arrays with negative strides.
4
!
5
! Contributed by Dick Hendrickson  
6
!                Clive Page        
7
!            and Mikael Morin      
8
!
9
program try_je0031
10
  integer ida(4)
11
  real dda(5,5,5,5,5)
12
  integer, parameter :: nx = 4, ny = 3
13
  interface
14
    SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)
15
      INTEGER IDA(4)
16
      REAL DDA(5,5,5,5,5)
17
      TARGET DDA
18
    END SUBROUTINE
19
  end interface
20
  integer :: array1(nx,ny), array2(nx,ny)
21
  data array2 / 1,2,3,4, 10,20,30,40, 100,200,300,400 /
22
  array1 = array2
23
  call PR38852(IDA,DDA,2,5,-2)
24
  call PR39006(array1, array2(:,ny:1:-1))
25
  call mikael         ! http://gcc.gnu.org/ml/fortran/2009-01/msg00342.html
26
contains
27
  subroutine PR39006(array1, array2)
28
    integer, intent(in) :: array1(:,:), array2(:,:)
29
    integer :: j
30
    do j = 1, ubound(array2,2)
31
      if (any (array1(:,j) .ne. array2(:,4-j))) call abort
32
    end do
33
  end subroutine
34
end
35
 
36
SUBROUTINE PR38852(IDA,DDA,nf2,nf5,mf2)
37
  INTEGER IDA(4)
38
  REAL DLA(:,:,:,:)
39
  REAL DDA(5,5,5,5,5)
40
  POINTER DLA
41
  TARGET DDA
42
  DLA => DDA(2:3, 1:3:2, 5:4:-1, NF2, NF5:NF2:MF2)
43
  IDA = UBOUND(DLA)
44
  if (any(ida /= 2)) call abort
45
  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
46
  IDA = UBOUND(DLA)
47
  if (any(ida /= 2)) call abort
48
!
49
! These worked.
50
!
51
  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
52
  IDA = shape(DLA)
53
  if (any(ida /= 2)) call abort
54
  DLA => DDA(2:3, 1:3:2, 5:4:-1, 2, 5:2:-2)
55
  IDA = LBOUND(DLA)
56
  if (any(ida /= 1)) call abort
57
END SUBROUTINE
58
 
59
subroutine mikael
60
  implicit none
61
  call test (1,  3, 3)
62
  call test (2,  3, 3)
63
  call test (2, -1, 0)
64
  call test (1, -1, 0)
65
contains
66
  subroutine test (a, b, expect)
67
    integer :: a, b, expect
68
    integer :: c(a:b)
69
    if (ubound (c, 1) .ne. expect) call abort
70
  end subroutine test
71
end subroutine

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.