Posted to tcl by jdc at Fri Jun 15 14:39:09 GMT 2007view raw

  1. package require Mk4tcl
  2. package require Thread
  3.  
  4. # Delete database from previous run an re-create it.
  5. file delete test.mk
  6. mk::file open db test.mk -shared -nocommit
  7.  
  8. mk::view layout db.pages {
  9. name
  10. page
  11. date:I
  12. who
  13. {changes {
  14. date:I
  15. who
  16. {diffs {
  17. from:I to:I old
  18. }}
  19. }}
  20. }
  21.  
  22. # Insert some data
  23. for { set i 0 } { $i < 20 } { incr i } {
  24. mk::row append db.pages name "Page $i" page "Page data $i" date [clock seconds] who Me
  25. for { set j 0 } { $j < 10 } { incr j } {
  26. mk::row append db.pages!$i.changes date [clock seconds] who me
  27. for { set k 0 } { $k < 5 } { incr k } {
  28. mk::row append db.pages!$i.changes!$j.diffs from $j to $k old "Old text"
  29. }
  30. }
  31. mk::file commit db
  32. }
  33.  
  34. # Create threads and test proc
  35. set nt 2
  36.  
  37. for { set t 0 } { $t < $nt } { incr t } {
  38. puts "Create thread $t"
  39. set tid($t) [thread::create {
  40. package require Mk4tcl
  41. thread::wait
  42. }]
  43. thread::send $tid($t) {
  44. proc put_mk { p c n } {
  45. for { set i 0 } { $i < $n } { incr i } {
  46. mk::row append db.pages name "Page $i" page "Page data $i" date [clock seconds] who Me
  47. mk::row append db.pages!$p.changes date [clock seconds] who me
  48. mk::row append db.pages!$p.changes!$c.diffs from 0 to 0 old "Old text"
  49. mk::file commit db
  50. after 1
  51. }
  52. }
  53. }
  54. thread::send $tid($t) {
  55. proc get_mk { p c d n } {
  56. for { set i 0 } { $i < $n } { incr i } {
  57. mk::get db.pages!$p name page date who
  58. mk::get db.pages!$p.changes!$c date who
  59. mk::get db.pages!$p.changes!$c.diffs!$d from to old
  60. after 1
  61. }
  62. }
  63. }
  64. }
  65.  
  66. # Run tests
  67. thread::send -async $tid(0) "put_mk 2 2 10000" result
  68. thread::send -async $tid(1) "get_mk 2 2 2 10000" result
  69.  
  70. # Wait...
  71. puts "waiting..."
  72.  
  73. for {set i 0} {$i < $nt} {incr i} {
  74. vwait result
  75. }
  76.  
  77. puts "Done"
  78.  
  79. exit