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/] [alloc_comp_basics_1.f90] - Blame information for rev 199

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


! { dg-do run}
! { dg-options "-O2 -fdump-tree-original" }
!
! Check some basic functionality of allocatable components, including that they
! are nullified when created and automatically deallocated when
! 1. A variable goes out of scope
! 2. INTENT(OUT) dummies
! 3. Function results
!
!
! Contributed by Erik Edelmann  
!            and Paul Thomas  
!
module alloc_m
 
    implicit none
 
    type :: alloc1
        real, allocatable :: x(:)
    end type alloc1
 
end module alloc_m
 
 
program alloc
 
    use alloc_m
 
    implicit none
 
    type :: alloc2
        type(alloc1), allocatable :: a1(:)
        integer, allocatable :: a2(:)
    end type alloc2
 
    type(alloc2) :: b
    integer :: i
    type(alloc2), allocatable :: c(:)
 
    if (allocated(b%a2) .OR. allocated(b%a1)) then
        write (0, *) 'main - 1'
        call abort()
    end if
 
    ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
    call allocate_alloc2(b)
    call check_alloc2(b)
 
    do i = 1, size(b%a1)
        ! 1 call to _gfortran_deallocate
        deallocate(b%a1(i)%x)
    end do
 
    ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
    call allocate_alloc2(b)
 
    call check_alloc2(return_alloc2())
    ! 3 calls to _gfortran_deallocate (function result)
 
    allocate(c(1))
    ! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)
    call allocate_alloc2(c(1))
    ! 4 calls to _gfortran_deallocate
    deallocate(c)
 
    ! 7 calls to _gfortran_deallocate (b (3) and c(4) goes aout of scope)
 
contains
 
    subroutine allocate_alloc2(b)
        type(alloc2), intent(out) :: b
        integer :: i
 
        if (allocated(b%a2) .OR. allocated(b%a1)) then
            write (0, *) 'allocate_alloc2 - 1'
            call abort()
        end if
 
        allocate (b%a2(3))
        b%a2 = [ 1, 2, 3 ]
 
        allocate (b%a1(3))
 
        do i = 1, 3
            if (allocated(b%a1(i)%x)) then
                write (0, *) 'allocate_alloc2 - 2', i
                call abort()
            end if
            allocate (b%a1(i)%x(3))
            b%a1(i)%x = i + [ 1.0, 2.0, 3.0 ]
        end do
 
    end subroutine allocate_alloc2
 
 
    type(alloc2) function return_alloc2() result(b)
        if (allocated(b%a2) .OR. allocated(b%a1)) then
            write (0, *) 'return_alloc2 - 1'
            call abort()
        end if
 
        allocate (b%a2(3))
        b%a2 = [ 1, 2, 3 ]
 
        allocate (b%a1(3))
 
        do i = 1, 3
            if (allocated(b%a1(i)%x)) then
                write (0, *) 'return_alloc2 - 2', i
                call abort()
            end if
            allocate (b%a1(i)%x(3))
            b%a1(i)%x = i + [ 1.0, 2.0, 3.0 ]
        end do
    end function return_alloc2
 
 
    subroutine check_alloc2(b)
        type(alloc2), intent(in) :: b
 
        if (.NOT.(allocated(b%a2) .AND. allocated(b%a1))) then
            write (0, *) 'check_alloc2 - 1'
            call abort()
        end if
        if (any(b%a2 /= [ 1, 2, 3 ])) then
            write (0, *) 'check_alloc2 - 2'
            call abort()
        end if
        do i = 1, 3
            if (.NOT.allocated(b%a1(i)%x)) then
                write (0, *) 'check_alloc2 - 3', i
                call abort()
            end if
            if (any(b%a1(i)%x /= i + [ 1.0, 2.0, 3.0 ])) then
                write (0, *) 'check_alloc2 - 4', i
                call abort()
            end if
        end do
    end subroutine check_alloc2
 
end program alloc
! { dg-final { scan-tree-dump-times "deallocate" 33 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

Line No.	Rev	Author	Line
1	149	jeremybenn	`! { dg-do run}`
2			`! { dg-options "-O2 -fdump-tree-original" }`
3			`!`
4			`! Check some basic functionality of allocatable components, including that they`
5			`! are nullified when created and automatically deallocated when`
6			`! 1. A variable goes out of scope`
7			`! 2. INTENT(OUT) dummies`
8			`! 3. Function results`
9			`!`
10			`!`
11			`! Contributed by Erik Edelmann`
12			`! and Paul Thomas`
13			`!`
14			`module alloc_m`
15
16			`implicit none`
17
18			`type :: alloc1`
19			`real, allocatable :: x(:)`
20			`end type alloc1`
21
22			`end module alloc_m`
23
24
25			`program alloc`
26
27			`use alloc_m`
28
29			`implicit none`
30
31			`type :: alloc2`
32			`type(alloc1), allocatable :: a1(:)`
33			`integer, allocatable :: a2(:)`
34			`end type alloc2`
35
36			`type(alloc2) :: b`
37			`integer :: i`
38			`type(alloc2), allocatable :: c(:)`
39
40			`if (allocated(b%a2) .OR. allocated(b%a1)) then`
41			`write (0, *) 'main - 1'`
42			`call abort()`
43			`end if`
44
45			`! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)`
46			`call allocate_alloc2(b)`
47			`call check_alloc2(b)`
48
49			`do i = 1, size(b%a1)`
50			`! 1 call to _gfortran_deallocate`
51			`deallocate(b%a1(i)%x)`
52			`end do`
53
54			`! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)`
55			`call allocate_alloc2(b)`
56
57			`call check_alloc2(return_alloc2())`
58			`! 3 calls to _gfortran_deallocate (function result)`
59
60			`allocate(c(1))`
61			`! 3 calls to _gfortran_deallocate (INTENT(OUT) dummy)`
62			`call allocate_alloc2(c(1))`
63			`! 4 calls to _gfortran_deallocate`
64			`deallocate(c)`
65
66			`! 7 calls to _gfortran_deallocate (b (3) and c(4) goes aout of scope)`
67
68			`contains`
69
70			`subroutine allocate_alloc2(b)`
71			`type(alloc2), intent(out) :: b`
72			`integer :: i`
73
74			`if (allocated(b%a2) .OR. allocated(b%a1)) then`
75			`write (0, *) 'allocate_alloc2 - 1'`
76			`call abort()`
77			`end if`
78
79			`allocate (b%a2(3))`
80			`b%a2 = [ 1, 2, 3 ]`
81
82			`allocate (b%a1(3))`
83
84			`do i = 1, 3`
85			`if (allocated(b%a1(i)%x)) then`
86			`write (0, *) 'allocate_alloc2 - 2', i`
87			`call abort()`
88			`end if`
89			`allocate (b%a1(i)%x(3))`
90			`b%a1(i)%x = i + [ 1.0, 2.0, 3.0 ]`
91			`end do`
92
93			`end subroutine allocate_alloc2`
94
95
96			`type(alloc2) function return_alloc2() result(b)`
97			`if (allocated(b%a2) .OR. allocated(b%a1)) then`
98			`write (0, *) 'return_alloc2 - 1'`
99			`call abort()`
100			`end if`
101
102			`allocate (b%a2(3))`
103			`b%a2 = [ 1, 2, 3 ]`
104
105			`allocate (b%a1(3))`
106
107			`do i = 1, 3`
108			`if (allocated(b%a1(i)%x)) then`
109			`write (0, *) 'return_alloc2 - 2', i`
110			`call abort()`
111			`end if`
112			`allocate (b%a1(i)%x(3))`
113			`b%a1(i)%x = i + [ 1.0, 2.0, 3.0 ]`
114			`end do`
115			`end function return_alloc2`
116
117
118			`subroutine check_alloc2(b)`
119			`type(alloc2), intent(in) :: b`
120
121			`if (.NOT.(allocated(b%a2) .AND. allocated(b%a1))) then`
122			`write (0, *) 'check_alloc2 - 1'`
123			`call abort()`
124			`end if`
125			`if (any(b%a2 /= [ 1, 2, 3 ])) then`
126			`write (0, *) 'check_alloc2 - 2'`
127			`call abort()`
128			`end if`
129			`do i = 1, 3`
130			`if (.NOT.allocated(b%a1(i)%x)) then`
131			`write (0, *) 'check_alloc2 - 3', i`
132			`call abort()`
133			`end if`
134			`if (any(b%a1(i)%x /= i + [ 1.0, 2.0, 3.0 ])) then`
135			`write (0, *) 'check_alloc2 - 4', i`
136			`call abort()`
137			`end if`
138			`end do`
139			`end subroutine check_alloc2`
140
141			`end program alloc`
142			`! { dg-final { scan-tree-dump-times "deallocate" 33 "original" } }`
143			`! { dg-final { cleanup-tree-dump "original" } }`

Browse

Tools

Subversion Repositories openrisc_me

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