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

Subversion Repositories openrisc_me

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

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.