gitlab.com/CoiaPrant/sqlite3@v1.19.1/testdata/tcl/bc_common.tcl (about)

     1  
     2  
     3  
     4  proc 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  
    35  proc get_version {binary} {
    36    set chan [launch_testfixture $binary]
    37    set v [testfixture $chan { sqlite3 -version }]
    38    close $chan
    39    set v
    40  }
    41  
    42  proc 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  
    71  proc do_all_bc_test {script} {
    72    foreach bin $::BC(binaries) {
    73      uplevel [list do_bc_test $bin $script]
    74    }
    75  }