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

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: test004.tcl,v 11.15 2000/08/25 14:21:54 sue Exp $
  7. #
  8. # DB Test 4 {access method}
  9. # Check that cursor operations work.  Create a database.
  10. # Read through the database sequentially using cursors and
  11. # delete each element.
  12. proc test004 { method {nentries 10000} {reopen 4} {build_only 0} args} {
  13. source ./include.tcl
  14. set do_renumber [is_rrecno $method]
  15. set args [convert_args $method $args]
  16. set omethod [convert_method $method]
  17. set tnum test00$reopen
  18. puts -nonewline "$tnum:
  19.     $method ($args) $nentries delete small key; medium data pairs"
  20. if {$reopen == 5} {
  21. puts "(with close)"
  22. } else {
  23. puts ""
  24. }
  25. # Create the database and open the dictionary
  26. set eindex [lsearch -exact $args "-env"]
  27. #
  28. # If we are using an env, then testfile should just be the db name.
  29. # Otherwise it is the test directory and the name.
  30. if { $eindex == -1 } {
  31. set testfile $testdir/test004.db
  32. set env NULL
  33. } else {
  34. set testfile test004.db
  35. incr eindex
  36. set env [lindex $args $eindex]
  37. }
  38. # Create the database and open the dictionary
  39. set t1 $testdir/t1
  40. set t2 $testdir/t2
  41. set t3 $testdir/t3
  42. cleanup $testdir $env
  43. set db [eval {berkdb_open -create -truncate -mode 0644} $args {$omethod $testfile}]
  44. error_check_good dbopen [is_valid_db $db] TRUE
  45. set did [open $dict]
  46. set pflags ""
  47. set gflags ""
  48. set txn ""
  49. set count 0
  50. if { [is_record_based $method] == 1 } {
  51. append gflags " -recno"
  52. }
  53. # Here is the loop where we put and get each key/data pair
  54. set kvals ""
  55. puts "tTest00$reopen.a: put/get loop"
  56. while { [gets $did str] != -1 && $count < $nentries } {
  57. if { [is_record_based $method] == 1 } {
  58. set key [expr $count + 1]
  59. lappend kvals $str
  60. } else {
  61. set key $str
  62. }
  63. set datastr [ make_data_str $str ]
  64. set ret [eval {$db put} $txn $pflags {$key [chop_data $method $datastr]}]
  65. error_check_good put $ret 0
  66. set ret [eval {$db get} $gflags {$key}]
  67. error_check_good "$tnum:put" $ret 
  68.     [list [list $key [pad_data $method $datastr]]]
  69. incr count
  70. }
  71. close $did
  72. if { $build_only == 1 } {
  73. return $db
  74. }
  75. if { $reopen == 5 } {
  76. error_check_good db_close [$db close] 0
  77. set db [eval {berkdb_open} $args {$testfile}]
  78. error_check_good dbopen [is_valid_db $db] TRUE
  79. }
  80. puts "tTest00$reopen.b: get/delete loop"
  81. # Now we will get each key from the DB and compare the results
  82. # to the original, then delete it.
  83. set outf [open $t1 w]
  84. set c [eval {$db cursor} $txn]
  85. set count 0
  86. for {set d [$c get -first] } { [llength $d] != 0 } {
  87.     set d [$c get -next] } {
  88. set k [lindex [lindex $d 0] 0]
  89. set d2 [lindex [lindex $d 0] 1]
  90. if { [is_record_based $method] == 1 } {
  91. set datastr 
  92.     [make_data_str [lindex $kvals [expr $k - 1]]]
  93. } else {
  94. set datastr [make_data_str $k]
  95. }
  96. error_check_good $tnum:$k $d2 [pad_data $method $datastr]
  97. puts $outf $k
  98. $c del
  99. if { [is_record_based $method] == 1 && 
  100. $do_renumber == 1 } {
  101. set kvals [lreplace $kvals 0 0]
  102. }
  103. incr count
  104. }
  105. close $outf
  106. error_check_good curs_close [$c close] 0
  107. # Now compare the keys to see if they match the dictionary
  108. if { [is_record_based $method] == 1 } {
  109. error_check_good test00$reopen:keys_deleted $count $nentries
  110. } else {
  111. set q q
  112. filehead $nentries $dict $t3
  113. filesort $t3 $t2
  114. filesort $t1 $t3
  115. error_check_good Test00$reopen:diff($t3,$t2) 
  116.     [filecmp $t3 $t2] 0
  117. }
  118. error_check_good db_close [$db close] 0
  119. }