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

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [pointer_assign_4.f90] - Blame information for rev 384

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn 
! { dg-do run }
2 
!
3 
! Verify that the bounds are correctly set when assigning pointers.
4 
!
5 
! PR fortran/33139
6 
!
7 
program prog
8 
  implicit none
9 
  real, target :: a(-10:10)
10 
  real, pointer :: p(:),p2(:)
11 
  integer :: i
12 
  do i = -10, 10
13 
    a(i) = real(i)
14 
  end do
15 
  p  => a
16 
  p2 => p
17 
  if((lbound(p, dim=1) /= -10) .or. (ubound(p, dim=1) /= 10)) &
18 
    call abort()
19 
  if((lbound(p2,dim=1) /= -10) .or. (ubound(p2,dim=1) /= 10)) &
20 
    call abort()
21 
  do i = -10, 10
22 
    if(p(i) /= real(i)) call abort()
23 
    if(p2(i) /= real(i)) call abort()
24 
  end do
25 
  p => a(:)
26 
  p2 => p
27 
  if((lbound(p, dim=1) /= 1) .or. (ubound(p, dim=1) /= 21)) &
28 
    call abort()
29 
  if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
30 
    call abort()
31 
  p2 => p(:)
32 
  if((lbound(p2,dim=1) /= 1) .or. (ubound(p2,dim=1) /= 21)) &
33 
    call abort()
34 
  call multdim()
35 
contains
36 
  subroutine multdim()
37 
    real, target, allocatable :: b(:,:,:)
38 
    real, pointer :: ptr(:,:,:)
39 
    integer :: i, j, k
40 
    allocate(b(-5:5,10:20,0:3))
41 
    do i = 0, 3
42 
      do j = 10, 20
43 
        do k = -5, 5
44 
          b(k,j,i) = real(i+10*j+100*k)
45 
        end do
46 
      end do
47 
    end do
48 
    ptr => b
49 
    if((lbound(ptr,dim=1) /= -5) .or. (ubound(ptr,dim=1) /=  5) .or. &
50 
       (lbound(ptr,dim=2) /= 10) .or. (ubound(ptr,dim=2) /= 20) .or. &
51 
       (lbound(ptr,dim=3) /=  0) .or. (ubound(ptr,dim=3) /=  3))     &
52 
      call abort()
53 
    do i = 0, 3
54 
      do j = 10, 20
55 
        do k = -5, 5
56 
          if(ptr(k,j,i) /= real(i+10*j+100*k)) call abort()
57 
        end do
58 
      end do
59 
    end do
60 
    ptr => b(:,:,:)
61 
    if((lbound(ptr,dim=1) /= 1) .or. (ubound(ptr,dim=1) /= 11) .or. &
62 
       (lbound(ptr,dim=2) /= 1) .or. (ubound(ptr,dim=2) /= 11) .or. &
63 
       (lbound(ptr,dim=3) /= 1) .or. (ubound(ptr,dim=3) /=  4))     &
64 
      call abort()
65 
  end subroutine multdim
66 
end program prog

powered by: WebSVN 2.1.0

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