xref: /sqlite-3.40.0/test/bc_common.tcl (revision de503eb1) 
1
2
3
4proc bc_find_binaries {zCaption} {
5  # Search for binaries to test against. Any executable files that match
6  # our naming convention are assumed to be testfixture binaries to test
7  # against.
8  #
9  set binaries [list]
10  set self [info nameofexec]
11  set pattern "$self?*"
12  if {$::tcl_platform(platform)=="windows"} {
13    set pattern [string map {\.exe {}} $pattern]
14  }
15  foreach file [glob -nocomplain $pattern] {
16    if {$file==$self} continue
17    if {[file executable $file] && [file isfile $file]} {lappend binaries $file}
18  }
19
20  if {[llength $binaries]==0} {
21    puts "WARNING: No historical binaries to test against."
22    puts "WARNING: Omitting backwards-compatibility tests"
23  }
24
25  foreach bin $binaries {
26    puts -nonewline "Testing against $bin - "
27    flush stdout
28    puts "version [get_version $bin]"
29  }
30
31  set ::BC(binaries) $binaries
32  return $binaries
33}
34
35proc get_version {binary} {
36  set chan [launch_testfixture $binary]
37  set v [testfixture $chan { sqlite3 -version }]
38  close $chan
39  set v
40}
41
42proc do_bc_test {bin script} {
43
44  forcedelete test.db
45  set ::bc_chan [launch_testfixture $bin]
46
47  proc code1 {tcl} { uplevel #0 $tcl }
48  proc code2 {tcl} { testfixture $::bc_chan $tcl }
49  proc sql1 sql { code1 [list db eval $sql] }
50  proc sql2 sql { code2 [list db eval $sql] }
51
52  code1 { sqlite3 db test.db }
53  code2 { sqlite3 db test.db }
54
55  set bintag $bin
56  regsub {.*testfixture\.} $bintag {} bintag
57  set bintag [string map {\.exe {}} $bintag]
58  if {$bintag == ""} {set bintag self}
59  set saved_prefix $::testprefix
60  append ::testprefix ".$bintag"
61
62  uplevel $script
63
64  set ::testprefix $saved_prefix
65
66  catch { code1 { db close } }
67  catch { code2 { db close } }
68  catch { close $::bc_chan }
69}
70
71proc do_all_bc_test {script} {
72  foreach bin $::BC(binaries) {
73    uplevel [list do_bc_test $bin $script]
74  }
75}
76