Posted to tcl by jdc at Fri Jun 15 14:39:09 GMT 2007view raw
- package require Mk4tcl
- package require Thread
- # Delete database from previous run an re-create it.
- file delete test.mk
- mk::file open db test.mk -shared -nocommit
- mk::view layout db.pages {
- name
- page
- date:I
- who
- {changes {
- date:I
- who
- {diffs {
- from:I to:I old
- }}
- }}
- }
- # Insert some data
- for { set i 0 } { $i < 20 } { incr i } {
- mk::row append db.pages name "Page $i" page "Page data $i" date [clock seconds] who Me
- for { set j 0 } { $j < 10 } { incr j } {
- mk::row append db.pages!$i.changes date [clock seconds] who me
- for { set k 0 } { $k < 5 } { incr k } {
- mk::row append db.pages!$i.changes!$j.diffs from $j to $k old "Old text"
- }
- }
- mk::file commit db
- }
- # Create threads and test proc
- set nt 2
- for { set t 0 } { $t < $nt } { incr t } {
- puts "Create thread $t"
- set tid($t) [thread::create {
- package require Mk4tcl
- thread::wait
- }]
- thread::send $tid($t) {
- proc put_mk { p c n } {
- for { set i 0 } { $i < $n } { incr i } {
- mk::row append db.pages name "Page $i" page "Page data $i" date [clock seconds] who Me
- mk::row append db.pages!$p.changes date [clock seconds] who me
- mk::row append db.pages!$p.changes!$c.diffs from 0 to 0 old "Old text"
- mk::file commit db
- after 1
- }
- }
- }
- thread::send $tid($t) {
- proc get_mk { p c d n } {
- for { set i 0 } { $i < $n } { incr i } {
- mk::get db.pages!$p name page date who
- mk::get db.pages!$p.changes!$c date who
- mk::get db.pages!$p.changes!$c.diffs!$d from to old
- after 1
- }
- }
- }
- }
- # Run tests
- thread::send -async $tid(0) "put_mk 2 2 10000" result
- thread::send -async $tid(1) "get_mk 2 2 2 10000" result
- # Wait...
- puts "waiting..."
- for {set i 0} {$i < $nt} {incr i} {
- vwait result
- }
- puts "Done"
- exit