stress.l (1599B)
1 # 25may11abu 2 # (c) Software Lab. Alexander Burger 3 # Use: nice pil misc/stress.l -main -go -bye; rm db/test jnl db/test2 4 5 (load "@lib/too.l") 6 7 (class +A +Entity) 8 (rel key (+Key +Number)) # Key 1 .. 999 9 (rel dat (+Ref +Number)) # Data 1 .. 999 10 11 (de rnd () 12 (rand 1 999) ) 13 14 (de modify (N) 15 (do N 16 (do (rand 10 40) 17 (let K (rnd) 18 (with (db 'key '+A K) 19 (unless (= K (: key)) 20 (quit "key mismatch" K) ) ) ) ) 21 (dbSync) 22 (let (D (rnd) X (db 'key '+A (rnd))) 23 (inc *DB (- D (get X 'dat))) 24 (put> X 'dat D) ) 25 (commit 'upd) ) ) 26 27 (de verify () 28 (dbCheck) 29 (let N 0 30 (scan (tree 'dat '+A) 31 '((K V) 32 (unless (= (car K) (get V 'dat)) 33 (quit "dat mismatch" K) ) 34 (inc 'N (car K)) ) ) 35 (unless (= N (val *DB)) 36 (quit "val mismatch" (- N (val *DB))) ) ) ) 37 38 (de main () 39 (seed (in "/dev/urandom" (rd 8))) 40 (call 'mkdir "-p" "db") 41 (call 'rm "-f" "db/test" "jnl" "db/test2") 42 (pool "db/test" NIL "jnl") 43 (set *DB 0) 44 (for K 999 45 (let D (rnd) 46 (new T '(+A) 'key K 'dat D) 47 (inc *DB D) ) ) 48 (commit) ) 49 50 (de go () 51 (do 10 52 (let Pids 53 (make 54 (do 40 55 (rand) 56 (if (fork) 57 (link @) 58 (modify 999) 59 (bye) ) ) ) 60 (while (find '((P) (kill P 0)) Pids) 61 (wait 1000) ) 62 (rollback) ) ) 63 (verify) 64 (pool "db/test2") 65 (journal "jnl") 66 (call 'cmp "db/test" "db/test2") )