test020.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: test020.tcl,v 11.12 2000/10/19 23:15:22 ubell Exp $
  7. #
  8. # DB Test 20 {access method}
  9. # Test in-memory databases.
  10. proc test020 { method {nentries 10000} args } {
  11. source ./include.tcl
  12. set args [convert_args $method $args]
  13. set omethod [convert_method $method]
  14. if { [is_queueext $method] == 1 || 
  15.     [is_rbtree $method] == 1 } {
  16. puts "Test020 skipping for method $method"
  17. return
  18. }
  19. puts "Test020: $method ($args) $nentries equal key/data pairs"
  20. # Create the database and open the dictionary
  21. set t1 $testdir/t1
  22. set t2 $testdir/t2
  23. set t3 $testdir/t3
  24. set eindex [lsearch -exact $args "-env"]
  25. #
  26. # Check if we are using an env.
  27. if { $eindex == -1 } {
  28. set env NULL
  29. } else {
  30. incr eindex
  31. set env [lindex $args $eindex]
  32. }
  33. cleanup $testdir $env
  34. set db [eval {berkdb_open 
  35.      -create -truncate -mode 0644} $args {$omethod}]
  36. error_check_good dbopen [is_valid_db $db] TRUE
  37. set did [open $dict]
  38. set pflags ""
  39. set gflags ""
  40. set txn ""
  41. set count 0
  42. if { [is_record_based $method] == 1 } {
  43. set checkfunc test020_recno.check
  44. append gflags " -recno"
  45. } else {
  46. set checkfunc test020.check
  47. }
  48. puts "tTest020.a: put/get loop"
  49. # Here is the loop where we put and get each key/data pair
  50. while { [gets $did str] != -1 && $count < $nentries } {
  51. if { [is_record_based $method] == 1 } {
  52. global kvals
  53. set key [expr $count + 1]
  54. set kvals($key) [pad_data $method $str]
  55. } else {
  56. set key $str
  57. }
  58. set ret [eval {$db put} 
  59.     $txn $pflags {$key [chop_data $method $str]}]
  60. error_check_good put $ret 0
  61. set ret [eval {$db get} $txn $gflags {$key}]
  62. error_check_good 
  63.     get $ret [list [list $key [pad_data $method $str]]]
  64. incr count
  65. }
  66. close $did
  67. # Now we will get each key from the DB and compare the results
  68. # to the original.
  69. puts "tTest020.b: dump file"
  70. dump_file $db $txn $t1 $checkfunc
  71. error_check_good db_close [$db close] 0
  72. # Now compare the keys to see if they match the dictionary (or ints)
  73. if { [is_record_based $method] == 1 } {
  74. set oid [open $t2 w]
  75. for {set i 1} {$i <= $nentries} {set i [incr i]} {
  76. puts $oid $i
  77. }
  78. close $oid
  79. file rename -force $t1 $t3
  80. } else {
  81. set q q
  82. filehead $nentries $dict $t3
  83. filesort $t3 $t2
  84. filesort $t1 $t3
  85. }
  86. error_check_good Test020:diff($t3,$t2) 
  87.     [filecmp $t3 $t2] 0
  88. }
  89. # Check function for test020; keys and data are identical
  90. proc test020.check { key data } {
  91. error_check_good "key/data mismatch" $data $key
  92. }
  93. proc test020_recno.check { key data } {
  94. global dict
  95. global kvals
  96. error_check_good key"$key"_exists [info exists kvals($key)] 1
  97. error_check_good "data mismatch: key $key" $data $kvals($key)
  98. }