lockscript.tcl
上传用户:tsgydb
上传日期:2007-04-14
资源大小:10674k
文件大小:2k
源码类别:

MySQL数据库

开发平台:

Visual C++

  1. # See the file LICENSE for redistribution information.
  2. #
  3. # Copyright (c) 1996, 1997, 1998, 1999, 2000
  4. # Sleepycat Software.  All rights reserved.
  5. #
  6. # $Id: lockscript.tcl,v 11.11 2000/03/24 19:53:39 krinsky Exp $
  7. #
  8. # Random lock tester.
  9. # Usage: lockscript dir numiters numobjs sleepint degree readratio
  10. # dir: lock directory.
  11. # numiters: Total number of iterations.
  12. # numobjs: Number of objects on which to lock.
  13. # sleepint: Maximum sleep interval.
  14. # degree: Maximum number of locks to acquire at once
  15. # readratio: Percent of locks that should be reads.
  16. source ./include.tcl
  17. source $test_path/test.tcl
  18. set usage "lockscript dir numiters numobjs sleepint degree readratio"
  19. # Verify usage
  20. if { $argc != 6 } {
  21. puts stderr "FAIL:[timestamp] Usage: $usage"
  22. exit
  23. }
  24. # Initialize arguments
  25. set dir [lindex $argv 0]
  26. set numiters [ lindex $argv 1 ]
  27. set numobjs [ lindex $argv 2 ]
  28. set sleepint [ lindex $argv 3 ]
  29. set degree [ lindex $argv 4 ]
  30. set readratio [ lindex $argv 5 ]
  31. set locker [pid]
  32. # Initialize random number generator
  33. global rand_init
  34. berkdb srand $rand_init
  35. puts -nonewline "Beginning execution for $locker: $numiters $numobjs "
  36. puts "$sleepint $degree $readratio"
  37. flush stdout
  38. set e [berkdb env -create -lock -home $dir]
  39. error_check_good env_open [is_substr $e env] 1
  40. for { set iter 0 } { $iter < $numiters } { incr iter } {
  41. set nlocks [berkdb random_int 1 $degree]
  42. # We will always lock objects in ascending order to avoid
  43. # deadlocks.
  44. set lastobj 1
  45. set locklist {}
  46. for { set lnum 0 } { $lnum < $nlocks } { incr lnum } {
  47. # Pick lock parameters
  48. set obj [berkdb random_int $lastobj $numobjs]
  49. set lastobj [expr $obj + 1]
  50. set x [berkdb random_int 1 100 ]
  51. if { $x <= $readratio } {
  52. set rw read
  53. } else {
  54. set rw write
  55. }
  56. puts "[timestamp] $locker $lnum: $rw $obj"
  57. # Do get; add to list
  58. set lockp [$e lock_get $rw $locker $obj]
  59. lappend locklist $lockp
  60. if {$lastobj > $numobjs} {
  61. break
  62. }
  63. }
  64. # Pick sleep interval
  65. tclsleep [berkdb random_int 1 $sleepint]
  66. # Now release locks
  67. puts "[timestamp] $locker released locks"
  68. release_list $locklist
  69. flush stdout
  70. }
  71. set ret [$e close]
  72. error_check_good env_close $ret 0
  73. puts "[timestamp] $locker Complete"
  74. flush stdout
  75. exit