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

MySQL数据库

开发平台:

Visual C++

  1. # See the file LICENSE for redistribution information.
  2. #
  3. # Copyright (c) 1999, 2000
  4. # Sleepycat Software.  All rights reserved.
  5. #
  6. # $Id: test086.tcl,v 11.2 2000/08/25 14:21:58 sue Exp $
  7. # Test086: Cursor stability across btree splits w/ subtransaction abort [#2373].
  8. proc test086 { method args } {
  9. global errorCode
  10. source ./include.tcl
  11. set tstn 086
  12. if { [is_btree $method] != 1 } {
  13. puts "Test$tstn skipping for method $method."
  14. return
  15. }
  16. set method "-btree"
  17. puts "tTest$tstn: Test of cursor stability across aborted
  18.     btree splits."
  19. set key "key"
  20. set data "data"
  21. set txn ""
  22. set flags ""
  23. set eindex [lsearch -exact $args "-env"]
  24. #
  25. # If we are using an env, then this test won't work.
  26. if { $eindex == -1 } {
  27. # But we will be using our own env...
  28. set testfile test0$tstn.db
  29. } else {
  30. puts "tTest$tstn: Environment provided;  skipping test."
  31. return
  32. }
  33. set t1 $testdir/t1
  34. env_cleanup $testdir
  35. set env [berkdb env -create -home $testdir -txn]
  36. error_check_good berkdb_env [is_valid_env $env] TRUE
  37. puts "tTest$tstn.a: Create $method database."
  38. set oflags "-create -env $env -mode 0644 $args $method"
  39. set db [eval {berkdb_open} $oflags $testfile]
  40. error_check_good dbopen [is_valid_db $db] TRUE
  41. set nkeys 5
  42. # Fill page w/ small key/data pairs, keep at leaf
  43. #
  44. puts "tTest$tstn.b: Fill page with $nkeys small key/data pairs."
  45. set txn [$env txn]
  46. error_check_good txn [is_valid_txn $txn $env] TRUE
  47. for { set i 0 } { $i < $nkeys } { incr i } {
  48. set ret [$db put -txn $txn key000$i $data$i]
  49. error_check_good dbput $ret 0
  50. }
  51. error_check_good commit [$txn commit] 0
  52. # get db ordering, set cursors
  53. puts "tTest$tstn.c: Set cursors on each of $nkeys pairs."
  54. set txn [$env txn]
  55. error_check_good txn [is_valid_txn $txn $env] TRUE
  56. for {set i 0; set ret [$db get -txn $txn key000$i]} {
  57. $i < $nkeys && [llength $ret] != 0} {
  58. incr i; set ret [$db get -txn $txn key000$i]} {
  59. set key_set($i) [lindex [lindex $ret 0] 0]
  60. set data_set($i) [lindex [lindex $ret 0] 1]
  61. set dbc [$db cursor -txn $txn]
  62. set dbc_set($i) $dbc
  63. error_check_good db_cursor:$i [is_substr $dbc_set($i) $db] 1
  64. set ret [$dbc_set($i) get -set $key_set($i)]
  65. error_check_bad dbc_set($i)_get:set [llength $ret] 0
  66. }
  67. # Create child txn.
  68. set ctxn [$env txn -parent $txn]
  69. error_check_good ctxn [is_valid_txn $txn $env] TRUE
  70. # if mkeys is above 1000, need to adjust below for lexical order
  71. set mkeys 1000
  72. puts "tTest$tstn.d: Add $mkeys pairs to force split."
  73. for {set i $nkeys} { $i < $mkeys } { incr i } {
  74. if { $i >= 100 } {
  75. set ret [$db put -txn $ctxn key0$i $data$i]
  76. } elseif { $i >= 10 } {
  77. set ret [$db put -txn $ctxn key00$i $data$i]
  78. } else {
  79. set ret [$db put -txn $ctxn key000$i $data$i]
  80. }
  81. error_check_good dbput:more $ret 0
  82. }
  83. puts "tTest$tstn.e: Abort."
  84. error_check_good ctxn_abort [$ctxn abort] 0
  85. puts "tTest$tstn.f: Check and see that cursors maintained reference."
  86. for {set i 0} { $i < $nkeys } {incr i} {
  87. set ret [$dbc_set($i) get -current]
  88. error_check_bad dbc$i:get:current [llength $ret] 0
  89. set ret2 [$dbc_set($i) get -set $key_set($i)]
  90. error_check_bad dbc$i:get:set [llength $ret2] 0
  91. error_check_good dbc$i:get(match) $ret $ret2
  92. }
  93. # Put (and this time keep) the keys that caused the split.  
  94. # We'll delete them to test reverse splits.
  95. puts "tTest$tstn.g: Put back added keys."
  96. for {set i $nkeys} { $i < $mkeys } { incr i } {
  97. if { $i >= 100 } {
  98. set ret [$db put -txn $txn key0$i $data$i]
  99. } elseif { $i >= 10 } {
  100. set ret [$db put -txn $txn key00$i $data$i]
  101. } else {
  102. set ret [$db put -txn $txn key000$i $data$i]
  103. }
  104. error_check_good dbput:more $ret 0
  105. }
  106. puts "tTest$tstn.h: Delete added keys to force reverse split."
  107. set ctxn [$env txn -parent $txn]
  108. error_check_good ctxn [is_valid_txn $txn $env] TRUE
  109. for {set i $nkeys} { $i < $mkeys } { incr i } {
  110. if { $i >= 100 } {
  111. error_check_good db_del:$i [$db del -txn $ctxn key0$i] 0
  112. } elseif { $i >= 10 } {
  113. error_check_good db_del:$i 
  114.     [$db del -txn $ctxn key00$i] 0
  115. } else {
  116. error_check_good db_del:$i 
  117.     [$db del -txn $ctxn key000$i] 0
  118. }
  119. }
  120. puts "tTest$tstn.i: Abort."
  121. error_check_good ctxn_abort [$ctxn abort] 0
  122. puts "tTest$tstn.j: Verify cursor reference."
  123. for {set i 0} { $i < $nkeys } {incr i} {
  124. set ret [$dbc_set($i) get -current]
  125. error_check_bad dbc$i:get:current [llength $ret] 0
  126. set ret2 [$dbc_set($i) get -set $key_set($i)]
  127. error_check_bad dbc$i:get:set [llength $ret2] 0
  128. error_check_good dbc$i:get(match) $ret $ret2
  129. }
  130. puts "tTest$tstn.j: Cleanup."
  131. # close cursors
  132. for {set i 0} { $i < $nkeys } {incr i} {
  133. error_check_good dbc_close:$i [$dbc_set($i) close] 0
  134. }
  135. error_check_good commit [$txn commit] 0
  136. error_check_good dbclose [$db close] 0
  137. error_check_good envclose [$env close] 0
  138. puts "tTest$tstn complete."
  139. }