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
|
# 25may11abu
# (c) Software Lab. Alexander Burger
# Use: nice pil misc/stress.l -main -go -bye; rm db/test jnl db/test2
(load "@lib/too.l")
(class +A +Entity)
(rel key (+Key +Number)) # Key 1 .. 999
(rel dat (+Ref +Number)) # Data 1 .. 999
(de rnd ()
(rand 1 999) )
(de modify (N)
(do N
(do (rand 10 40)
(let K (rnd)
(with (db 'key '+A K)
(unless (= K (: key))
(quit "key mismatch" K) ) ) ) )
(dbSync)
(let (D (rnd) X (db 'key '+A (rnd)))
(inc *DB (- D (get X 'dat)))
(put> X 'dat D) )
(commit 'upd) ) )
(de verify ()
(dbCheck)
(let N 0
(scan (tree 'dat '+A)
'((K V)
(unless (= (car K) (get V 'dat))
(quit "dat mismatch" K) )
(inc 'N (car K)) ) )
(unless (= N (val *DB))
(quit "val mismatch" (- N (val *DB))) ) ) )
(de main ()
(seed (in "/dev/urandom" (rd 8)))
(call 'mkdir "-p" "db")
(call 'rm "-f" "db/test" "jnl" "db/test2")
(pool "db/test" NIL "jnl")
(set *DB 0)
(for K 999
(let D (rnd)
(new T '(+A) 'key K 'dat D)
(inc *DB D) ) )
(commit) )
(de go ()
(do 10
(let Pids
(make
(do 40
(rand)
(if (fork)
(link @)
(modify 999)
(bye) ) ) )
(while (find '((P) (kill P 0)) Pids)
(wait 1000) )
(rollback) ) )
(verify)
(pool "db/test2")
(journal "jnl")
(call 'cmp "db/test" "db/test2") )
|
