/ Hex Artifact Content
Login

Artifact b5e42d80305be95697e6370e015af571e5333a1c:


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 73 65 6c 66 20 5b 69 6e 66 6f 20   set self [info 
00f0: 6e 61 6d 65 6f 66 65 78 65 63 5d 0a 20 20 73 65  nameofexec].  se
0100: 74 20 70 61 74 74 65 72 6e 20 22 24 73 65 6c 66  t pattern "$self
0110: 3f 2a 22 0a 20 20 69 66 20 7b 24 3a 3a 74 63 6c  ?*".  if {$::tcl
0120: 5f 70 6c 61 74 66 6f 72 6d 28 70 6c 61 74 66 6f  _platform(platfo
0130: 72 6d 29 3d 3d 22 77 69 6e 64 6f 77 73 22 7d 20  rm)=="windows"} 
0140: 7b 0a 20 20 20 20 73 65 74 20 70 61 74 74 65 72  {.    set patter
0150: 6e 20 5b 73 74 72 69 6e 67 20 6d 61 70 20 7b 5c  n [string map {\
0160: 2e 65 78 65 20 7b 7d 7d 20 24 70 61 74 74 65 72  .exe {}} $patter
0170: 6e 5d 0a 20 20 7d 0a 20 20 66 6f 72 65 61 63 68  n].  }.  foreach
0180: 20 66 69 6c 65 20 5b 67 6c 6f 62 20 2d 6e 6f 63   file [glob -noc
0190: 6f 6d 70 6c 61 69 6e 20 24 70 61 74 74 65 72 6e  omplain $pattern
01a0: 5d 20 7b 0a 20 20 20 20 69 66 20 7b 24 66 69 6c  ] {.    if {$fil
01b0: 65 3d 3d 24 73 65 6c 66 7d 20 63 6f 6e 74 69 6e  e==$self} contin
01c0: 75 65 0a 20 20 20 20 69 66 20 7b 5b 66 69 6c 65  ue.    if {[file
01d0: 20 65 78 65 63 75 74 61 62 6c 65 20 24 66 69 6c   executable $fil
01e0: 65 5d 20 26 26 20 5b 66 69 6c 65 20 69 73 66 69  e] && [file isfi
01f0: 6c 65 20 24 66 69 6c 65 5d 7d 20 7b 6c 61 70 70  le $file]} {lapp
0200: 65 6e 64 20 62 69 6e 61 72 69 65 73 20 24 66 69  end binaries $fi
0210: 6c 65 7d 0a 20 20 7d 0a 0a 20 20 69 66 20 7b 5b  le}.  }..  if {[
0220: 6c 6c 65 6e 67 74 68 20 24 62 69 6e 61 72 69 65  llength $binarie
0230: 73 5d 3d 3d 30 7d 20 7b 0a 20 20 20 20 70 75 74  s]==0} {.    put
0240: 73 20 22 57 41 52 4e 49 4e 47 3a 20 4e 6f 20 68  s "WARNING: No h
0250: 69 73 74 6f 72 69 63 61 6c 20 62 69 6e 61 72 69  istorical binari
0260: 65 73 20 74 6f 20 74 65 73 74 20 61 67 61 69 6e  es to test again
0270: 73 74 2e 22 0a 20 20 20 20 70 75 74 73 20 22 57  st.".    puts "W
0280: 41 52 4e 49 4e 47 3a 20 4f 6d 69 74 74 69 6e 67  ARNING: Omitting
0290: 20 62 61 63 6b 77 61 72 64 73 2d 63 6f 6d 70 61   backwards-compa
02a0: 74 69 62 69 6c 69 74 79 20 74 65 73 74 73 22 0a  tibility tests".
02b0: 20 20 7d 0a 0a 20 20 66 6f 72 65 61 63 68 20 62    }..  foreach b
02c0: 69 6e 20 24 62 69 6e 61 72 69 65 73 20 7b 0a 20  in $binaries {. 
02d0: 20 20 20 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69     puts -nonewli
02e0: 6e 65 20 22 54 65 73 74 69 6e 67 20 61 67 61 69  ne "Testing agai
02f0: 6e 73 74 20 24 62 69 6e 20 2d 20 22 0a 20 20 20  nst $bin - ".   
0300: 20 66 6c 75 73 68 20 73 74 64 6f 75 74 0a 20 20   flush stdout.  
0310: 20 20 70 75 74 73 20 22 76 65 72 73 69 6f 6e 20    puts "version 
0320: 5b 67 65 74 5f 76 65 72 73 69 6f 6e 20 24 62 69  [get_version $bi
0330: 6e 5d 22 0a 20 20 7d 0a 0a 20 20 73 65 74 20 3a  n]".  }..  set :
0340: 3a 42 43 28 62 69 6e 61 72 69 65 73 29 20 24 62  :BC(binaries) $b
0350: 69 6e 61 72 69 65 73 0a 20 20 72 65 74 75 72 6e  inaries.  return
0360: 20 24 62 69 6e 61 72 69 65 73 0a 7d 0a 0a 70 72   $binaries.}..pr
0370: 6f 63 20 67 65 74 5f 76 65 72 73 69 6f 6e 20 7b  oc get_version {
0380: 62 69 6e 61 72 79 7d 20 7b 0a 20 20 73 65 74 20  binary} {.  set 
0390: 63 68 61 6e 20 5b 6c 61 75 6e 63 68 5f 74 65 73  chan [launch_tes
03a0: 74 66 69 78 74 75 72 65 20 24 62 69 6e 61 72 79  tfixture $binary
03b0: 5d 0a 20 20 73 65 74 20 76 20 5b 74 65 73 74 66  ].  set v [testf
03c0: 69 78 74 75 72 65 20 24 63 68 61 6e 20 7b 20 73  ixture $chan { s
03d0: 71 6c 69 74 65 33 20 2d 76 65 72 73 69 6f 6e 20  qlite3 -version 
03e0: 7d 5d 0a 20 20 63 6c 6f 73 65 20 24 63 68 61 6e  }].  close $chan
03f0: 0a 20 20 73 65 74 20 76 0a 7d 0a 0a 70 72 6f 63  .  set v.}..proc
0400: 20 64 6f 5f 62 63 5f 74 65 73 74 20 7b 62 69 6e   do_bc_test {bin
0410: 20 73 63 72 69 70 74 7d 20 7b 0a 0a 20 20 66 6f   script} {..  fo
0420: 72 63 65 64 65 6c 65 74 65 20 74 65 73 74 2e 64  rcedelete test.d
0430: 62 0a 20 20 73 65 74 20 3a 3a 62 63 5f 63 68 61  b.  set ::bc_cha
0440: 6e 20 5b 6c 61 75 6e 63 68 5f 74 65 73 74 66 69  n [launch_testfi
0450: 78 74 75 72 65 20 24 62 69 6e 5d 0a 0a 20 20 70  xture $bin]..  p
0460: 72 6f 63 20 63 6f 64 65 31 20 7b 74 63 6c 7d 20  roc code1 {tcl} 
0470: 7b 20 75 70 6c 65 76 65 6c 20 23 30 20 24 74 63  { uplevel #0 $tc
0480: 6c 20 7d 0a 20 20 70 72 6f 63 20 63 6f 64 65 32  l }.  proc code2
0490: 20 7b 74 63 6c 7d 20 7b 20 74 65 73 74 66 69 78   {tcl} { testfix
04a0: 74 75 72 65 20 24 3a 3a 62 63 5f 63 68 61 6e 20  ture $::bc_chan 
04b0: 24 74 63 6c 20 7d 0a 20 20 70 72 6f 63 20 73 71  $tcl }.  proc sq
04c0: 6c 31 20 73 71 6c 20 7b 20 63 6f 64 65 31 20 5b  l1 sql { code1 [
04d0: 6c 69 73 74 20 64 62 20 65 76 61 6c 20 24 73 71  list db eval $sq
04e0: 6c 5d 20 7d 0a 20 20 70 72 6f 63 20 73 71 6c 32  l] }.  proc sql2
04f0: 20 73 71 6c 20 7b 20 63 6f 64 65 32 20 5b 6c 69   sql { code2 [li
0500: 73 74 20 64 62 20 65 76 61 6c 20 24 73 71 6c 5d  st db eval $sql]
0510: 20 7d 0a 0a 20 20 63 6f 64 65 31 20 7b 20 73 71   }..  code1 { sq
0520: 6c 69 74 65 33 20 64 62 20 74 65 73 74 2e 64 62  lite3 db test.db
0530: 20 7d 0a 20 20 63 6f 64 65 32 20 7b 20 73 71 6c   }.  code2 { sql
0540: 69 74 65 33 20 64 62 20 74 65 73 74 2e 64 62 20  ite3 db test.db 
0550: 7d 0a 0a 20 20 73 65 74 20 62 69 6e 74 61 67 20  }..  set bintag 
0560: 24 62 69 6e 0a 20 20 72 65 67 73 75 62 20 7b 2e  $bin.  regsub {.
0570: 2a 74 65 73 74 66 69 78 74 75 72 65 5c 2e 7d 20  *testfixture\.} 
0580: 24 62 69 6e 74 61 67 20 7b 7d 20 62 69 6e 74 61  $bintag {} binta
0590: 67 0a 20 20 73 65 74 20 62 69 6e 74 61 67 20 5b  g.  set bintag [
05a0: 73 74 72 69 6e 67 20 6d 61 70 20 7b 5c 2e 65 78  string map {\.ex
05b0: 65 20 7b 7d 7d 20 24 62 69 6e 74 61 67 5d 0a 20  e {}} $bintag]. 
05c0: 20 69 66 20 7b 24 62 69 6e 74 61 67 20 3d 3d 20   if {$bintag == 
05d0: 22 22 7d 20 7b 73 65 74 20 62 69 6e 74 61 67 20  ""} {set bintag 
05e0: 73 65 6c 66 7d 0a 20 20 73 65 74 20 73 61 76 65  self}.  set save
05f0: 64 5f 70 72 65 66 69 78 20 24 3a 3a 74 65 73 74  d_prefix $::test
0600: 70 72 65 66 69 78 0a 20 20 61 70 70 65 6e 64 20  prefix.  append 
0610: 3a 3a 74 65 73 74 70 72 65 66 69 78 20 22 2e 24  ::testprefix ".$
0620: 62 69 6e 74 61 67 22 0a 0a 20 20 75 70 6c 65 76  bintag"..  uplev
0630: 65 6c 20 24 73 63 72 69 70 74 0a 0a 20 20 73 65  el $script..  se
0640: 74 20 3a 3a 74 65 73 74 70 72 65 66 69 78 20 24  t ::testprefix $
0650: 73 61 76 65 64 5f 70 72 65 66 69 78 0a 0a 20 20  saved_prefix..  
0660: 63 61 74 63 68 20 7b 20 63 6f 64 65 31 20 7b 20  catch { code1 { 
0670: 64 62 20 63 6c 6f 73 65 20 7d 20 7d 0a 20 20 63  db close } }.  c
0680: 61 74 63 68 20 7b 20 63 6f 64 65 32 20 7b 20 64  atch { code2 { d
0690: 62 20 63 6c 6f 73 65 20 7d 20 7d 0a 20 20 63 61  b close } }.  ca
06a0: 74 63 68 20 7b 20 63 6c 6f 73 65 20 24 3a 3a 62  tch { close $::b
06b0: 63 5f 63 68 61 6e 20 7d 0a 7d 0a 0a 70 72 6f 63  c_chan }.}..proc
06c0: 20 64 6f 5f 61 6c 6c 5f 62 63 5f 74 65 73 74 20   do_all_bc_test 
06d0: 7b 73 63 72 69 70 74 7d 20 7b 0a 20 20 66 6f 72  {script} {.  for
06e0: 65 61 63 68 20 62 69 6e 20 24 3a 3a 42 43 28 62  each bin $::BC(b
06f0: 69 6e 61 72 69 65 73 29 20 7b 0a 20 20 20 20 75  inaries) {.    u
0700: 70 6c 65 76 65 6c 20 5b 6c 69 73 74 20 64 6f 5f  plevel [list do_
0710: 62 63 5f 74 65 73 74 20 24 62 69 6e 20 24 73 63  bc_test $bin $sc
0720: 72 69 70 74 5d 0a 20 20 7d 0a 7d 0a              ript].  }.}.