rev: 3827f53bae88e48a594610914ba74b9512ead6dd tukan/testing/test_pool.sc -rw-r--r-- 3.4 KiB View raw Log this file
3827f53bae88 — Leonard Ritter * more work on module system 3 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
using import Array

using import ..tukan.Pool

let stdio = (include "stdio.h")
using stdio.extern filter "^(printf)$"

fn test-pool-alloc ()
    using import ..tukan.random

    print "starting..."

    let N = 10000
    # our "data array", which just stores the id again, so we can easily verify
    # if an id still matches its assigned content
    local data : (Array u32)
    'resize data N

    local pool : Pool

    fn move_entry (data k0 k1)
        if (k0 != k1)
            data @ k1 = data @ k0

    fn verify_data (pool data)
        local twisted = 0:u32
        for i in pool
            let id = ('resolve pool i)
            assert (data @ i == id)
            assert (('resolve pool id) == i)
            if (not ('identity? pool i))
                twisted += 1:u32
        deref twisted

    fn test_obtain (pool data)
        let handle k0 k1 = ('obtain pool)
        move_entry data k0 k1
        data @ k0 = k0
        handle

    fn test_release (pool data handle)
        let k0 k1 = ('release pool handle)
        move_entry data k0 k1

    # array of ids in use
    local used : (Array Pool.Handle)
    'resize used N

    local mintwisted : u32 = N
    local maxtwisted : u32 = 0
    local total : u32 = 0
    local steps : u32 = 0
    local used_count : u32 = 0
    local maxused : u32 = 1

    # keep 0 handle
    do
        let handle = (test_obtain pool data)
        #print "obtained" handle
        #'dump pool
        used @ used_count = handle
        used_count += 1
        assert (used_count == (countof pool))
        verify_data pool data

    local rnd : (Random)
    'seed rnd 14

    static-if 1
        let STEPS = 100000
        # do random obtains/releases, see if something breaks
        for i in (range STEPS)
            if ((('range rnd 0 100) < 48) & (used_count > 1))
                let used_index = ('range rnd 1:u32 used_count)
                let handle = (deref (used @ used_index))
                #print "released" id
                # remove from used array and fill
                used_count -= 1
                used @ used_index = used @ used_count
                used @ used_count = (nullof Pool.Handle)
                test_release pool data handle
                #'dump pool
                assert (used_count == (countof pool))
                let t = (verify_data pool data)
                mintwisted = (min mintwisted t)
                maxtwisted = (max maxtwisted t)
                total += t
                steps += 1
            else
                let handle = (test_obtain pool data)
                #print "obtained" handle
                #'dump pool
                used @ used_count = handle
                used_count += 1
                maxused = (max maxused used_count)
                assert (used_count == (countof pool))
                verify_data pool data
    #else
        # attempt to fabricate a worst case
        for i in (range N)
            test_obtain pool data
        for i in (range 0:u32 N 2:u32)
            test_release pool data i
            let t = (verify_data pool data)
            mintwisted = (min mintwisted t)
            maxtwisted = (max maxtwisted t)
            total += t
            steps += 1

    #'dump pool
    print
        \ "max used:" maxused
        \ "releases:" steps
        \ "min twisted:" mintwisted
        \ "max twisted:" maxtwisted
        \ "total twisted:" total
        \ "average:" (total / steps)
    print "OK."
    ;

test-pool-alloc;

;