test026.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: test026.tcl,v 11.13 2000/11/17 19:07:51 sue Exp $
  7. #
  8. # DB Test 26 {access method}
  9. # Keyed delete test through cursor.
  10. # If ndups is small; this will test on-page dups; if it's large, it
  11. # will test off-page dups.
  12. proc test026 { method {nentries 2000} {ndups 5} {tnum 26} args} {
  13. source ./include.tcl
  14. set args [convert_args $method $args]
  15. set omethod [convert_method $method]
  16. if { [is_record_based $method] == 1 || 
  17.     [is_rbtree $method] == 1 } {
  18. puts "Test0$tnum skipping for method $method"
  19. return
  20. }
  21. puts "Test0$tnum: $method ($args) $nentries keys
  22. with $ndups dups; cursor delete test"
  23. # Create the database and open the dictionary
  24. set eindex [lsearch -exact $args "-env"]
  25. #
  26. # If we are using an env, then testfile should just be the db name.
  27. # Otherwise it is the test directory and the name.
  28. if { $eindex == -1 } {
  29. set testfile $testdir/test0$tnum.db
  30. set env NULL
  31. } else {
  32. set testfile test0$tnum.db
  33. incr eindex
  34. set env [lindex $args $eindex]
  35. }
  36. cleanup $testdir $env
  37. set pflags ""
  38. set gflags ""
  39. set txn ""
  40. set count 0
  41. # Here is the loop where we put and get each key/data pair
  42. puts "tTest0$tnum.a: Put loop"
  43. set db [eval {berkdb_open -create -truncate 
  44. -mode 0644} $args {$omethod -dup $testfile}]
  45. error_check_good dbopen [is_valid_db $db] TRUE
  46. set did [open $dict]
  47. while { [gets $did str] != -1 && $count < [expr $nentries * $ndups] } {
  48. set datastr [ make_data_str $str ]
  49. for { set j 1 } { $j <= $ndups} {incr j} {
  50.  set ret [eval {$db put} 
  51.      $txn $pflags {$str [chop_data $method $j$datastr]}]
  52. error_check_good db_put $ret 0
  53. incr count
  54. }
  55. }
  56. close $did
  57. error_check_good db_close [$db close] 0
  58. set db [eval {berkdb_open} $args $testfile]
  59. error_check_good dbopen [is_valid_db $db] TRUE
  60. # Now we will sequentially traverse the database getting each
  61. # item and deleting it.
  62. set count 0
  63. set dbc [eval {$db cursor} $txn]
  64. error_check_good db_cursor [is_substr $dbc $db] 1
  65. puts "tTest0$tnum.b: Get/delete loop"
  66. set i 1
  67. for { set ret [$dbc get -first] } {
  68.     [string length $ret] != 0 } {
  69.     set ret [$dbc get -next] } {
  70. set key [lindex [lindex $ret 0] 0]
  71. set data [lindex [lindex $ret 0] 1]
  72. if { $i == 1 } {
  73. set curkey $key
  74. }
  75. error_check_good seq_get:key $key $curkey
  76. error_check_good 
  77.     seq_get:data $data [pad_data $method $i[make_data_str $key]]
  78. if { $i == $ndups } {
  79. set i 1
  80. } else {
  81. incr i
  82. }
  83. # Now delete the key
  84. set ret [$dbc del]
  85. error_check_good db_del:$key $ret 0
  86. }
  87. error_check_good dbc_close [$dbc close] 0
  88. error_check_good db_close [$db close] 0
  89. puts "tTest0$tnum.c: Verify empty file"
  90. # Double check that file is now empty
  91. set db [eval {berkdb_open} $args $testfile]
  92. error_check_good dbopen [is_valid_db $db] TRUE
  93. set dbc [eval {$db cursor} $txn]
  94. error_check_good db_cursor [is_substr $dbc $db] 1
  95. set ret [$dbc get -first]
  96. error_check_good get_on_empty [string length $ret] 0
  97. error_check_good dbc_close [$dbc close] 0
  98. error_check_good db_close [$db close] 0
  99. }