开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数据库系统 > MySQL数据库 > 查看源码
test-2.6.patch
资源名称：mysql-3.23.35.tar.gz　[点击查看]
上传用户：tsgydb
上传日期：2007-04-14
资源大小：10674k
文件大小：10k
源码类别：

MySQL数据库

开发平台：

Visual C++

test-2.6.patch：源码内容
  1. diff -crN test.orig/test.tcl test/test.tcl
  2. *** test.orig/test.tcl Fri Dec 11 14:56:26 1998
  3. --- test/test.tcl Mon Oct  4 15:26:16 1999
  4. ***************
  5. *** 8,13 ****
  6. --- 8,14 ----
  7.   source ./include.tcl
  8.   source ../test/testutils.tcl
  9.   source ../test/byteorder.tcl
  10. + source ../test/upgrade.tcl
  11.   
  12.   set testdir ./TESTDIR
  13.   if { [file exists $testdir] != 1 } {
  14. ***************
  15. *** 114,119 ****
  16. --- 115,124 ----
  17.    global debug_print
  18.    global debug_on
  19.    global runtests
  20. + 
  21. +  global __method
  22. +  set __method $method
  23. + 
  24.    if { $stop == 0 } {
  25.    set stop $runtests
  26.    }
  27. diff -crN test.orig/testutils.tcl test/testutils.tcl
  28. *** test.orig/testutils.tcl Tue Dec 15 07:58:51 1998
  29. --- test/testutils.tcl Wed Oct  6 17:40:45 1999
  30. ***************
  31. *** 680,690 ****
  32. --- 680,698 ----
  33.   
  34.   proc cleanup { dir } {
  35.   source ./include.tcl
  36. + global __method
  37. + global errorInfo
  38.    # Remove the database and environment.
  39.    txn_unlink $dir 1
  40.    memp_unlink $dir 1
  41.    log_unlink $dir 1
  42.    lock_unlink $dir 1
  43. + 
  44. +  catch { exec mkdir -p /work/upgrade/2.6/$__method } res
  45. +  puts $res
  46. +  catch { exec sh -c "mv $dir/*.db /work/upgrade/2.6/$__method" } res
  47. +  puts $res
  48. + 
  49.    set ret [catch { glob $dir/* } result]
  50.    if { $ret == 0 } {
  51.    eval exec $RM -rf $result
  52. diff -crN test.orig/upgrade.tcl test/upgrade.tcl
  53. *** test.orig/upgrade.tcl Wed Dec 31 19:00:00 1969
  54. --- test/upgrade.tcl Mon Oct 18 21:22:39 1999
  55. ***************
  56. *** 0 ****
  57. --- 1,322 ----
  58. + # See the file LICENSE for redistribution information.
  59. + #
  60. + # Copyright (c) 1999
  61. + # Sleepycat Software.  All rights reserved.
  62. + #
  63. + # @(#)upgrade.tcl 11.1 (Sleepycat) 8/23/99
  64. + #
  65. + source ./include.tcl
  66. + global gen_upgrade
  67. + set gen_upgrade 0
  68. + global upgrade_dir
  69. + set upgrade_dir "/work/upgrade/DOTEST"
  70. + global upgrade_be
  71. + global upgrade_method
  72. + 
  73. + proc upgrade { } {
  74. +  source ./include.tcl
  75. +  global upgrade_dir
  76. + 
  77. +  foreach version [glob $upgrade_dir/*] {
  78. +  regexp [^/]*$ $version version
  79. +  foreach method [glob $upgrade_dir/$version/*] {
  80. +  regexp [^/]*$ $method method
  81. +  foreach file [glob $upgrade_dir/$version/$method/*] {
  82. +  puts $file
  83. +  regexp ([^/]*).tar.gz$ $file dummy name
  84. +  foreach endianness {"le" "be"} {
  85. +  puts "Update: $version $method $name $endianness"
  86. +  set ret [catch {_upgrade $upgrade_dir $testdir $version $method $name $endianness 1 1} message]
  87. +  if { $ret != 0 } {
  88. +  puts $message
  89. +  }
  90. +  }
  91. +  }
  92. +  }
  93. +  }
  94. + }
  95. + 
  96. + proc _upgrade { source_dir temp_dir version method file endianness do_db_load_test do_upgrade_test } {
  97. +  source include.tcl
  98. +  global errorInfo
  99. + 
  100. +  cleanup $temp_dir
  101. + 
  102. +  exec tar zxf "$source_dir/$version/$method/$file.tar.gz" -C $temp_dir
  103. + 
  104. +  if { $do_db_load_test } {
  105. +  set ret [catch 
  106. +      {exec ./db_load -f "$temp_dir/$file.dump" 
  107. +      "$temp_dir/upgrade.db"} message]
  108. +  error_check_good 
  109. +      "Update load: $version $method $file $message" $ret 0
  110. + 
  111. +  set ret [catch 
  112. +      {exec ./db_dump -f "$temp_dir/upgrade.dump" 
  113. +      "$temp_dir/upgrade.db"} message]
  114. +  error_check_good 
  115. +      "Update dump: $version $method $file $message" $ret 0
  116. + 
  117. +  error_check_good "Update diff.1.1: $version $method $file" 
  118. +          [catch { exec $CMP "$temp_dir/$file.dump" "$temp_dir/upgrade.dump" } ret] 0
  119. +      error_check_good "Update diff.1.2: $version $method $file" $ret ""
  120. +  }
  121. + 
  122. +  if { $do_upgrade_test } {
  123. +  set ret [catch {berkdb open -upgrade "$temp_dir/$file-$endianness.db"} db]
  124. +  if { $ret == 1 } {
  125. +  if { ![is_substr $errorInfo "version upgrade"] } {
  126. +  set fnl [string first "n" $errorInfo]
  127. +  set theError [string range $errorInfo 0 [expr $fnl - 1]]
  128. +  error $theError
  129. +  }
  130. +  } else {
  131. +      error_check_good dbopen [is_valid_db $db] TRUE
  132. +      error_check_good dbclose [$db close] 0
  133. +      
  134. +      set ret [catch 
  135. +      {exec ./db_dump -f "$temp_dir/upgrade.dump" 
  136. +      "$temp_dir/$file-$endianness.db"} message]
  137. +  error_check_good 
  138. +      "Update dump: $version $method $file $message" $ret 0
  139. + 
  140. +  error_check_good "Update diff.2: $version $method $file" 
  141. +      [catch { exec $CMP "$temp_dir/$file.dump" "$temp_dir/upgrade.dump" } ret] 0
  142. +       error_check_good "Update diff.2: $version $method $file" $ret ""
  143. +  }
  144. +  }
  145. + }
  146. + 
  147. + proc gen_upgrade { dir } {
  148. +  global gen_upgrade
  149. +  global upgrade_dir
  150. +  global upgrade_be
  151. +  global upgrade_method
  152. +  global __method
  153. +  global runtests
  154. +  source ./include.tcl
  155. +  set tclsh_path "/work/db/upgrade/db-2.6.6/build_unix/dbtest"
  156. + 
  157. +  set gen_upgrade 1
  158. +  set upgrade_dir $dir
  159. + 
  160. +  foreach upgrade_be { 0 1 } {
  161. +  foreach i "rrecno" {
  162. +  # "hash btree rbtree hash recno rrecno" 
  163. +  puts "Running $i tests"
  164. +  set upgrade_method $i
  165. +  for { set j 1 } { $j <= $runtests } {incr j} {
  166. +  if [catch {exec $tclsh_path 
  167. +      << "source ../test/test.tcl; 
  168. +      run_method $i $j $j"} res] {
  169. +  puts "FAIL: [format "test%03d" $j] $i"
  170. +  }
  171. +  puts $res
  172. +  set __method $i
  173. +  cleanup $testdir
  174. +  }
  175. +  }
  176. +  }
  177. + 
  178. +  set gen_upgrade 0
  179. + }
  180. + 
  181. + proc upgrade_dump { database file {with_binkey 0} } {
  182. +  source ./include.tcl
  183. +  global errorInfo
  184. + 
  185. +  set is_recno 0
  186. + 
  187. +  set db [dbopen $database 0 0600 DB_UNKNOWN]
  188. +  set dbc [$db cursor 0]
  189. + 
  190. +  set f [open $file w+]
  191. +  fconfigure $f -encoding binary -translation binary
  192. + 
  193. +  #
  194. +  # Get a sorted list of keys
  195. +  #
  196. +  set key_list ""
  197. +  if { [catch {set pair [$dbc get "" $DB_FIRST]}] != 0 } {
  198. +  set pair [$dbc get 0 $DB_FIRST]
  199. +  set is_recno 1
  200. +  }
  201. + 
  202. +  while { 1 } {
  203. +  if { [llength $pair] == 0 } {
  204. +  break
  205. +  }
  206. +  lappend key_list [list [lindex $pair 0]]
  207. +  set pair [$dbc get 0 $DB_NEXT]
  208. +  }
  209. + 
  210. + 
  211. +  # Discard duplicated keys;  we now have a key for each
  212. +  # duplicate, not each unique key, and we don't want to get each
  213. +  # duplicate multiple times when we iterate over key_list. 
  214. +  set uniq_keys {}
  215. +  foreach key $key_list {
  216. +  if { [info exists existence_list($key)] == 0 } {
  217. +  lappend uniq_keys [list $key]
  218. +  }
  219. +  set existence_list($key) 1
  220. +  }
  221. +  set key_list $uniq_keys
  222. + 
  223. +  set key_list [lsort -command _comp $key_list]
  224. + 
  225. +  #foreach llave $key_list {
  226. +  # puts $llave
  227. +  #}
  228. + 
  229. +  #
  230. +  # Get the data for each key
  231. +  #
  232. + 
  233. +  for { set i 0 } { $i < [llength $key_list] } { incr i } {
  234. +  set key [concat [lindex $key_list $i]]
  235. +  # XXX Gross awful hack.  We want to DB_SET in the vast
  236. +  # majority of cases, but DB_SET can't handle binary keys
  237. +  # in the 2.X Tcl interface.  So we look manually and linearly
  238. +  # for the key we want if with_binkey == 1.
  239. +  if { $with_binkey != 1 } {
  240. +  set pair [$dbc get $key $DB_SET]
  241. +  } else {
  242. +  set pair [_search_binkey $key $dbc]
  243. +  }
  244. +  if { $is_recno != 1 } {
  245. +  set key [upgrade_convkey $key $dbc]
  246. +  }
  247. +  #puts "pair:$pair:[lindex $pair 1]"
  248. +  set data [lindex $pair 1]
  249. +  set data [upgrade_convdata $data $dbc]
  250. +  set data_list [list $data]
  251. +  catch { while { $is_recno == 0 } {
  252. +  set pair [$dbc get 0 $DB_NEXT_DUP]
  253. +  if { [llength $pair] == 0 } {
  254. +  break
  255. +  }
  256. + 
  257. +  set data [lindex $pair 1]
  258. +  set data [upgrade_convdata $data $dbc]
  259. +  lappend data_list [list $data]
  260. +  } }
  261. +  set data_list [lsort -command _comp $data_list]
  262. +  puts -nonewline $f [binary format i [string length $key]]
  263. +  puts -nonewline $f $key
  264. +  puts -nonewline $f [binary format i [llength $data_list]]
  265. +  for { set j 0 } { $j < [llength $data_list] } { incr j } {
  266. +  puts -nonewline $f [binary format i [string length [concat [lindex $data_list $j]]]]
  267. +  puts -nonewline $f [concat [lindex $data_list $j]]
  268. +  }
  269. +  }
  270. + 
  271. +  close $f
  272. + }
  273. + 
  274. + proc _comp { a b } {
  275. + # return expr [[concat $a] < [concat $b]]
  276. +  return [string compare [concat $a] [concat $b]]
  277. + }
  278. + 
  279. + # Converts a key to the format of keys in the 3.X Tcl interface
  280. + proc upgrade_convkey { key dbc } {
  281. +  source ./include.tcl
  282. + 
  283. +  # Stick a null on the end.
  284. +  set k "$key"
  285. + 
  286. +  set tmp $testdir/gb0
  287. + 
  288. +  # Attempt a dbc getbinkey to get any additional parts of the key.
  289. +  set dbt [$dbc getbinkey $tmp 0 $DB_CURRENT]
  290. + 
  291. +  set tmpid [open $tmp r]
  292. +  fconfigure $tmpid -encoding binary -translation binary
  293. +  set cont [read $tmpid]
  294. + 
  295. +  set k $k$cont
  296. + 
  297. +  close $tmpid
  298. + 
  299. +  exec $RM -f $tmp
  300. + 
  301. +  return $k
  302. + }
  303. + 
  304. + # Converts a datum to the format of data in the 3.X Tcl interface
  305. + proc upgrade_convdata { data dbc } {
  306. +  source ./include.tcl
  307. +  set is_partial 0
  308. + 
  309. +  # Get the datum out of "data"
  310. +  if { [llength $data] == 1 } {
  311. +  set d [lindex $data 0]
  312. +  } elseif { [llength $data] == 2 } {
  313. +  # It was a partial return;  the first arg is the number of nuls
  314. +  set d [lindex $data 1]
  315. +  set numnul [lindex $data 0]
  316. +  while { $numnul > 0 } {
  317. +  set d "$d"
  318. +  incr numnul -1
  319. +  }
  320. + 
  321. +  # The old Tcl getbin and the old Tcl partial put
  322. +  # interface are incompatible;  we'll wind up returning
  323. +  # the datum twice if we try a getbin now.  So
  324. +  # set a flag to avoid it.
  325. +  set is_partial 1
  326. + 
  327. +  } else {
  328. +  set d $data
  329. +  }
  330. + 
  331. + 
  332. +  if { $is_partial != 1 } {
  333. + 
  334. +  # Stick a null on the end.
  335. +  set d "$d"
  336. + 
  337. +  set tmp $testdir/gb1
  338. + 
  339. +  # Attempt a dbc getbin to get any additional parts of the datum
  340. +  # the Tcl interface has neglected.
  341. +  set dbt [$dbc getbin $tmp 0 $DB_CURRENT]
  342. + 
  343. +  set tmpid [open $tmp r]
  344. +  fconfigure $tmpid -encoding binary -translation binary
  345. +  set cont [read $tmpid]
  346. + 
  347. +  set d $d$cont
  348. + 
  349. +  #puts "$data->$d"
  350. + 
  351. +  close $tmpid
  352. +  }
  353. + 
  354. +  return [list $d]
  355. + }
  356. + 
  357. + # Implement the DB_SET functionality, stupidly, in terms of DB_NEXT and
  358. + # manual comparisons.  We have to use this instead of DB_SET with 
  359. + # binary keys, as the old Tcl interface can't handle binary keys but DB_SET
  360. + # requires them.  So instead, we page through using DB_NEXT, which returns 
  361. + # the binary keys only up to the first null, and compare to our specified
  362. + # key, which is similarly truncated.
  363. + #
  364. + # This is really slow, but is seldom used.
  365. + proc _search_binkey { key dbc } {
  366. +  #puts "doing _search_binkey $key $dbc"
  367. +  source ./include.tcl
  368. +  set dbt [$dbc get 0 $DB_FIRST]
  369. +  while { [llength $dbt] != 0 } {
  370. +  set curkey [lindex $dbt 0]
  371. +  if { [string compare $key $curkey] == 0 } { 
  372. +  return $dbt 
  373. +  }
  374. +  set dbt [$dbc get 0 $DB_NEXT]
  375. +  }
  376. + 
  377. +  # We didn't find it.  Return an empty list.
  378. +  return {}
  379. + }