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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [shape_2.f90] - Blame information for rev 823

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 149 jeremybenn 
! Check that lbound() and ubound() work correctly for assumed shapes.
2 
! { dg-do run }
3 
program main
4 
  integer, dimension (40, 80) :: a = 1
5 
  call test (a)
6 
contains
7 
  subroutine test (b)
8 
    integer, dimension (11:, -8:), target :: b
9 
    integer, dimension (:, :), pointer :: ptr
10 
 
11 
    if (lbound (b, 1) .ne. 11) call abort
12 
    if (ubound (b, 1) .ne. 50) call abort
13 
    if (lbound (b, 2) .ne. -8) call abort
14 
    if (ubound (b, 2) .ne. 71) call abort
15 
 
16 
    if (lbound (b (:, :), 1) .ne. 1) call abort
17 
    if (ubound (b (:, :), 1) .ne. 40) call abort
18 
    if (lbound (b (:, :), 2) .ne. 1) call abort
19 
    if (ubound (b (:, :), 2) .ne. 80) call abort
20 
 
21 
    if (lbound (b (20:30:3, 40), 1) .ne. 1) call abort
22 
    if (ubound (b (20:30:3, 40), 1) .ne. 4) call abort
23 
 
24 
    ptr => b
25 
    if (lbound (ptr, 1) .ne. 1) call abort
26 
    if (ubound (ptr, 1) .ne. 40) call abort
27 
    if (lbound (ptr, 2) .ne. 1) call abort
28 
    if (ubound (ptr, 2) .ne. 80) call abort
29 
  end subroutine test
30 
end program main

powered by: WebSVN 2.1.0

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