/ Hex Artifact Content
Login

Artifact 5c8689cc6d2fb44b7c0968ae4f85eb26d50022fa:


0000: 0a 0a 0a 70 72 6f 63 20 62 63 5f 66 69 6e 64 5f  ...proc bc_find_
0010: 62 69 6e 61 72 69 65 73 20 7b 7a 43 61 70 74 69  binaries {zCapti
0020: 6f 6e 7d 20 7b 0a 20 20 23 20 53 65 61 72 63 68  on} {.  # Search
0030: 20 66 6f 72 20 62 69 6e 61 72 69 65 73 20 74 6f   for binaries to
0040: 20 74 65 73 74 20 61 67 61 69 6e 73 74 2e 20 41   test against. A
0050: 6e 79 20 65 78 65 63 75 74 61 62 6c 65 20 66 69  ny executable fi
0060: 6c 65 73 20 74 68 61 74 20 6d 61 74 63 68 0a 20  les that match. 
0070: 20 23 20 6f 75 72 20 6e 61 6d 69 6e 67 20 63 6f   # our naming co
0080: 6e 76 65 6e 74 69 6f 6e 20 61 72 65 20 61 73 73  nvention are ass
0090: 75 6d 65 64 20 74 6f 20 62 65 20 74 65 73 74 66  umed to be testf
00a0: 69 78 74 75 72 65 20 62 69 6e 61 72 69 65 73 20  ixture binaries 
00b0: 74 6f 20 74 65 73 74 0a 20 20 23 20 61 67 61 69  to test.  # agai
00c0: 6e 73 74 2e 0a 20 20 23 0a 20 20 73 65 74 20 62  nst..  #.  set b
00d0: 69 6e 61 72 69 65 73 20 5b 6c 69 73 74 5d 0a 20  inaries [list]. 
00e0: 20 73 65 74 20 70 61 74 74 65 72 6e 20 22 5b 66   set pattern "[f
00f0: 69 6c 65 20 74 61 69 6c 20 5b 69 6e 66 6f 20 6e  ile tail [info n
0100: 61 6d 65 6f 66 65 78 65 63 5d 5d 3f 2a 22 0a 20  ameofexec]]?*". 
0110: 20 69 66 20 7b 24 3a 3a 74 63 6c 5f 70 6c 61 74   if {$::tcl_plat
0120: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 3d 3d  form(platform)==
0130: 22 77 69 6e 64 6f 77 73 22 7d 20 7b 0a 20 20 20  "windows"} {.   
0140: 20 73 65 74 20 70 61 74 74 65 72 6e 20 5b 73 74   set pattern [st
0150: 72 69 6e 67 20 6d 61 70 20 7b 5c 2e 65 78 65 20  ring map {\.exe 
0160: 7b 7d 7d 20 24 70 61 74 74 65 72 6e 5d 0a 20 20  {}} $pattern].  
0170: 7d 0a 20 20 66 6f 72 65 61 63 68 20 66 69 6c 65  }.  foreach file
0180: 20 5b 67 6c 6f 62 20 2d 6e 6f 63 6f 6d 70 6c 61   [glob -nocompla
0190: 69 6e 20 24 70 61 74 74 65 72 6e 5d 20 7b 0a 20  in $pattern] {. 
01a0: 20 20 20 69 66 20 7b 5b 66 69 6c 65 20 65 78 65     if {[file exe
01b0: 63 75 74 61 62 6c 65 20 24 66 69 6c 65 5d 20 26  cutable $file] &
01c0: 26 20 5b 66 69 6c 65 20 69 73 66 69 6c 65 20 24  & [file isfile $
01d0: 66 69 6c 65 5d 7d 20 7b 6c 61 70 70 65 6e 64 20  file]} {lappend 
01e0: 62 69 6e 61 72 69 65 73 20 24 66 69 6c 65 7d 0a  binaries $file}.
01f0: 20 20 7d 0a 0a 20 20 69 66 20 7b 5b 6c 6c 65 6e    }..  if {[llen
0200: 67 74 68 20 24 62 69 6e 61 72 69 65 73 5d 3d 3d  gth $binaries]==
0210: 30 7d 20 7b 0a 20 20 20 20 70 75 74 73 20 22 57  0} {.    puts "W
0220: 41 52 4e 49 4e 47 3a 20 4e 6f 20 68 69 73 74 6f  ARNING: No histo
0230: 72 69 63 61 6c 20 62 69 6e 61 72 69 65 73 20 74  rical binaries t
0240: 6f 20 74 65 73 74 20 61 67 61 69 6e 73 74 2e 22  o test against."
0250: 0a 20 20 20 20 70 75 74 73 20 22 57 41 52 4e 49  .    puts "WARNI
0260: 4e 47 3a 20 4f 6d 69 74 74 69 6e 67 20 62 61 63  NG: Omitting bac
0270: 6b 77 61 72 64 73 2d 63 6f 6d 70 61 74 69 62 69  kwards-compatibi
0280: 6c 69 74 79 20 74 65 73 74 73 22 0a 20 20 7d 0a  lity tests".  }.
0290: 0a 20 20 66 6f 72 65 61 63 68 20 62 69 6e 20 24  .  foreach bin $
02a0: 62 69 6e 61 72 69 65 73 20 7b 0a 20 20 20 20 70  binaries {.    p
02b0: 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20 22  uts -nonewline "
02c0: 54 65 73 74 69 6e 67 20 61 67 61 69 6e 73 74 20  Testing against 
02d0: 24 62 69 6e 20 2d 20 22 0a 20 20 20 20 66 6c 75  $bin - ".    flu
02e0: 73 68 20 73 74 64 6f 75 74 0a 20 20 20 20 70 75  sh stdout.    pu
02f0: 74 73 20 22 76 65 72 73 69 6f 6e 20 5b 67 65 74  ts "version [get
0300: 5f 76 65 72 73 69 6f 6e 20 24 62 69 6e 5d 22 0a  _version $bin]".
0310: 20 20 7d 0a 0a 20 20 73 65 74 20 3a 3a 42 43 28    }..  set ::BC(
0320: 62 69 6e 61 72 69 65 73 29 20 24 62 69 6e 61 72  binaries) $binar
0330: 69 65 73 0a 20 20 72 65 74 75 72 6e 20 24 62 69  ies.  return $bi
0340: 6e 61 72 69 65 73 0a 7d 0a 0a 70 72 6f 63 20 67  naries.}..proc g
0350: 65 74 5f 76 65 72 73 69 6f 6e 20 7b 62 69 6e 61  et_version {bina
0360: 72 79 7d 20 7b 0a 20 20 73 65 74 20 63 68 61 6e  ry} {.  set chan
0370: 20 5b 6c 61 75 6e 63 68 5f 74 65 73 74 66 69 78   [launch_testfix
0380: 74 75 72 65 20 24 62 69 6e 61 72 79 5d 0a 20 20  ture $binary].  
0390: 73 65 74 20 76 20 5b 74 65 73 74 66 69 78 74 75  set v [testfixtu
03a0: 72 65 20 24 63 68 61 6e 20 7b 20 73 71 6c 69 74  re $chan { sqlit
03b0: 65 33 20 2d 76 65 72 73 69 6f 6e 20 7d 5d 0a 20  e3 -version }]. 
03c0: 20 63 6c 6f 73 65 20 24 63 68 61 6e 0a 20 20 73   close $chan.  s
03d0: 65 74 20 76 0a 7d 0a 0a 70 72 6f 63 20 64 6f 5f  et v.}..proc do_
03e0: 62 63 5f 74 65 73 74 20 7b 62 69 6e 20 73 63 72  bc_test {bin scr
03f0: 69 70 74 7d 20 7b 0a 0a 20 20 66 6f 72 63 65 64  ipt} {..  forced
0400: 65 6c 65 74 65 20 74 65 73 74 2e 64 62 0a 20 20  elete test.db.  
0410: 73 65 74 20 3a 3a 62 63 5f 63 68 61 6e 20 5b 6c  set ::bc_chan [l
0420: 61 75 6e 63 68 5f 74 65 73 74 66 69 78 74 75 72  aunch_testfixtur
0430: 65 20 24 62 69 6e 5d 0a 0a 20 20 70 72 6f 63 20  e $bin]..  proc 
0440: 63 6f 64 65 31 20 7b 74 63 6c 7d 20 7b 20 75 70  code1 {tcl} { up
0450: 6c 65 76 65 6c 20 23 30 20 24 74 63 6c 20 7d 0a  level #0 $tcl }.
0460: 20 20 70 72 6f 63 20 63 6f 64 65 32 20 7b 74 63    proc code2 {tc
0470: 6c 7d 20 7b 20 74 65 73 74 66 69 78 74 75 72 65  l} { testfixture
0480: 20 24 3a 3a 62 63 5f 63 68 61 6e 20 24 74 63 6c   $::bc_chan $tcl
0490: 20 7d 0a 20 20 70 72 6f 63 20 73 71 6c 31 20 73   }.  proc sql1 s
04a0: 71 6c 20 7b 20 63 6f 64 65 31 20 5b 6c 69 73 74  ql { code1 [list
04b0: 20 64 62 20 65 76 61 6c 20 24 73 71 6c 5d 20 7d   db eval $sql] }
04c0: 0a 20 20 70 72 6f 63 20 73 71 6c 32 20 73 71 6c  .  proc sql2 sql
04d0: 20 7b 20 63 6f 64 65 32 20 5b 6c 69 73 74 20 64   { code2 [list d
04e0: 62 20 65 76 61 6c 20 24 73 71 6c 5d 20 7d 0a 0a  b eval $sql] }..
04f0: 20 20 63 6f 64 65 31 20 7b 20 73 71 6c 69 74 65    code1 { sqlite
0500: 33 20 64 62 20 74 65 73 74 2e 64 62 20 7d 0a 20  3 db test.db }. 
0510: 20 63 6f 64 65 32 20 7b 20 73 71 6c 69 74 65 33   code2 { sqlite3
0520: 20 64 62 20 74 65 73 74 2e 64 62 20 7d 0a 0a 20   db test.db }.. 
0530: 20 73 65 74 20 62 69 6e 74 61 67 20 5b 73 74 72   set bintag [str
0540: 69 6e 67 20 6d 61 70 20 7b 74 65 73 74 66 69 78  ing map {testfix
0550: 74 75 72 65 20 7b 7d 7d 20 24 62 69 6e 5d 0a 20  ture {}} $bin]. 
0560: 20 73 65 74 20 62 69 6e 74 61 67 20 5b 73 74 72   set bintag [str
0570: 69 6e 67 20 6d 61 70 20 7b 5c 2e 65 78 65 20 7b  ing map {\.exe {
0580: 7d 7d 20 24 62 69 6e 74 61 67 5d 0a 20 20 69 66  }} $bintag].  if
0590: 20 7b 24 62 69 6e 74 61 67 20 3d 3d 20 22 22 7d   {$bintag == ""}
05a0: 20 7b 73 65 74 20 62 69 6e 74 61 67 20 73 65 6c   {set bintag sel
05b0: 66 7d 0a 20 20 73 65 74 20 73 61 76 65 64 5f 70  f}.  set saved_p
05c0: 72 65 66 69 78 20 24 3a 3a 74 65 73 74 70 72 65  refix $::testpre
05d0: 66 69 78 0a 20 20 61 70 70 65 6e 64 20 3a 3a 74  fix.  append ::t
05e0: 65 73 74 70 72 65 66 69 78 20 22 2e 24 62 69 6e  estprefix ".$bin
05f0: 74 61 67 22 0a 0a 20 20 75 70 6c 65 76 65 6c 20  tag"..  uplevel 
0600: 24 73 63 72 69 70 74 0a 0a 20 20 73 65 74 20 3a  $script..  set :
0610: 3a 74 65 73 74 70 72 65 66 69 78 20 24 73 61 76  :testprefix $sav
0620: 65 64 5f 70 72 65 66 69 78 0a 0a 20 20 63 61 74  ed_prefix..  cat
0630: 63 68 20 7b 20 63 6f 64 65 31 20 7b 20 64 62 20  ch { code1 { db 
0640: 63 6c 6f 73 65 20 7d 20 7d 0a 20 20 63 61 74 63  close } }.  catc
0650: 68 20 7b 20 63 6f 64 65 32 20 7b 20 64 62 20 63  h { code2 { db c
0660: 6c 6f 73 65 20 7d 20 7d 0a 20 20 63 61 74 63 68  lose } }.  catch
0670: 20 7b 20 63 6c 6f 73 65 20 24 3a 3a 62 63 5f 63   { close $::bc_c
0680: 68 61 6e 20 7d 0a 7d 0a 0a 70 72 6f 63 20 64 6f  han }.}..proc do
0690: 5f 61 6c 6c 5f 62 63 5f 74 65 73 74 20 7b 73 63  _all_bc_test {sc
06a0: 72 69 70 74 7d 20 7b 0a 20 20 66 6f 72 65 61 63  ript} {.  foreac
06b0: 68 20 62 69 6e 20 24 3a 3a 42 43 28 62 69 6e 61  h bin $::BC(bina
06c0: 72 69 65 73 29 20 7b 0a 20 20 20 20 75 70 6c 65  ries) {.    uple
06d0: 76 65 6c 20 5b 6c 69 73 74 20 64 6f 5f 62 63 5f  vel [list do_bc_
06e0: 74 65 73 74 20 24 62 69 6e 20 24 73 63 72 69 70  test $bin $scrip
06f0: 74 5d 0a 20 20 7d 0a 7d 0a                       t].  }.}.