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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [allocatable_dummy_1.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 procedures with allocatable dummy arguments
3
program alloc_dummy
4
 
5
    implicit none
6
    integer, allocatable :: a(:)
7
    integer, allocatable :: b(:)
8
 
9
    call init(a)
10
    if (.NOT.allocated(a)) call abort()
11
    if (.NOT.all(a == [ 1, 2, 3 ])) call abort()
12
 
13
    call useit(a, b)
14
    if (.NOT.all(b == [ 1, 2, 3 ])) call abort()
15
 
16
    if (.NOT.all(whatever(a) == [ 1, 2, 3 ])) call abort()
17
 
18
    call kill(a)
19
    if (allocated(a)) call abort()
20
 
21
    call kill(b)
22
    if (allocated(b)) call abort()
23
 
24
contains
25
 
26
    subroutine init(x)
27
        integer, allocatable, intent(out) :: x(:)
28
        allocate(x(3))
29
        x = [ 1, 2, 3 ]
30
    end subroutine init
31
 
32
    subroutine useit(x, y)
33
        integer, allocatable, intent(in)  :: x(:)
34
        integer, allocatable, intent(out) :: y(:)
35
        if (allocated(y)) call abort()
36
        call init(y)
37
        y = x
38
    end subroutine useit
39
 
40
    function whatever(x)
41
        integer, allocatable :: x(:)
42
        integer :: whatever(size(x))
43
 
44
        whatever = x
45
    end function whatever
46
 
47
    subroutine kill(x)
48
        integer, allocatable, intent(out) :: x(:)
49
    end subroutine kill
50
 
51
end program alloc_dummy

powered by: WebSVN 2.1.0

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