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

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: test036.tcl,v 11.13 2000/08/25 14:21:55 sue Exp $
  7. #
  8. # DB Test 36 {access method}
  9. # Put nentries key/data pairs (from the dictionary) using a cursor
  10. # and KEYFIRST and KEYLAST (this tests the case where use use cursor
  11. # put for non-existent keys).
  12. proc test036 { method {nentries 10000} args } {
  13. source ./include.tcl
  14. set args [convert_args $method $args]
  15. set omethod [convert_method $method]
  16. puts "Test036: $method ($args) $nentries equal key/data pairs"
  17. if { [is_record_based $method] == 1 } {
  18. puts "Test036 skipping for method recno"
  19. return
  20. }
  21. # Create the database and open the dictionary
  22. set eindex [lsearch -exact $args "-env"]
  23. #
  24. # If we are using an env, then testfile should just be the db name.
  25. # Otherwise it is the test directory and the name.
  26. if { $eindex == -1 } {
  27. set testfile $testdir/test036.db
  28. set env NULL
  29. } else {
  30. set testfile test036.db
  31. incr eindex
  32. set env [lindex $args $eindex]
  33. }
  34. set t1 $testdir/t1
  35. set t2 $testdir/t2
  36. set t3 $testdir/t3
  37. cleanup $testdir $env
  38. set db [eval {berkdb_open 
  39.      -create -truncate -mode 0644} $args {$omethod $testfile}]
  40. error_check_good dbopen [is_valid_db $db] TRUE
  41. set did [open $dict]
  42. set pflags ""
  43. set gflags ""
  44. set txn ""
  45. set count 0
  46. if { [is_record_based $method] == 1 } {
  47. set checkfunc test036_recno.check
  48. append gflags " -recno"
  49. } else {
  50. set checkfunc test036.check
  51. }
  52. puts "tTest036.a: put/get loop KEYFIRST"
  53. # Here is the loop where we put and get each key/data pair
  54. set dbc [eval {$db cursor} $txn]
  55. error_check_good cursor [is_substr $dbc $db] 1
  56. while { [gets $did str] != -1 && $count < $nentries } {
  57. if { [is_record_based $method] == 1 } {
  58. global kvals
  59. set key [expr $count + 1]
  60. set kvals($key) $str
  61. } else {
  62. set key $str
  63. }
  64. set ret [eval {$dbc put} $txn $pflags {-keyfirst $key $str}]
  65. error_check_good put $ret 0
  66. set ret [eval {$db get} $txn $gflags {$key}]
  67. error_check_good get [lindex [lindex $ret 0] 1] $str
  68. incr count
  69. }
  70. error_check_good dbc_close [$dbc close] 0
  71. puts "tTest036.a: put/get loop KEYLAST"
  72. set dbc [eval {$db cursor} $txn]
  73. error_check_good cursor [is_substr $dbc $db] 1
  74. while { [gets $did str] != -1 && $count < $nentries } {
  75. if { [is_record_based $method] == 1 } {
  76. global kvals
  77. set key [expr $count + 1]
  78. set kvals($key) $str
  79. } else {
  80. set key $str
  81. }
  82. set ret [eval {$dbc put} $txn $pflags {-keylast $key $str}]
  83. error_check_good put $ret 0
  84. set ret [eval {$db get} $txn $gflags {$key}]
  85. error_check_good get [lindex [lindex $ret 0] 1] $str
  86. incr count
  87. }
  88. error_check_good dbc_close [$dbc close] 0
  89. close $did
  90. # Now we will get each key from the DB and compare the results
  91. # to the original.
  92. puts "tTest036.c: dump file"
  93. dump_file $db $txn $t1 $checkfunc
  94. error_check_good db_close [$db close] 0
  95. # Now compare the keys to see if they match the dictionary (or ints)
  96. if { [is_record_based $method] == 1 } {
  97. set oid [open $t2 w]
  98. for {set i 1} {$i <= $nentries} {set i [incr i]} {
  99. puts $oid $i
  100. }
  101. close $oid
  102. file rename -force $t1 $t3
  103. } else {
  104. set q q
  105. filehead $nentries $dict $t3
  106. filesort $t3 $t2
  107. filesort $t1 $t3
  108. }
  109. }
  110. # Check function for test036; keys and data are identical
  111. proc test036.check { key data } {
  112. error_check_good "key/data mismatch" $data $key
  113. }
  114. proc test036_recno.check { key data } {
  115. global dict
  116. global kvals
  117. error_check_good key"$key"_exists [info exists kvals($key)] 1
  118. error_check_good "key/data mismatch, key $key" $data $kvals($key)
  119. }