test/testrunner.tcl

   1
   2 set dir [pwd]
   3 set testdir [file normalize [file dirname $argv0]]
   4 set saved $argv
   5 set argv [list]
   6 source [file join $testdir testrunner_data.tcl]
   7 source [file join $testdir permutations.test]
   8 set argv $saved
   9 cd $dir
  10
  11 # This script requires an interpreter that supports [package require sqlite3]
  12 # to run. If this is not such an intepreter, see if there is a [testfixture]
  13 # in the current directory. If so, run the command using it. If not,
  14 # recommend that the user build one.
  15 #
  16 proc find_interpreter {} {
  17   set interpreter [file tail [info nameofexec]]
  18   set rc [catch { package require sqlite3 }]
  19   if {$rc} {
  20     if { [string match -nocase testfixture* $interpreter]==0
  21       && [file executable ./testfixture]
  22     } {
  23       puts "Failed to find tcl package sqlite3. Restarting with ./testfixture.."
  24       set status [catch {
  25           exec ./testfixture [info script] {*}$::argv >@ stdout
  26       } msg]
  27       exit $status
  28     }
  29   }
  30   if {$rc} {
  31     puts stderr "Failed to find tcl package sqlite3"
  32     puts stderr "Run \"make testfixture\" and then try again..."
  33     exit 1
  34   }
  35 }
  36 find_interpreter
  37
  38 # Usually this script is run by [testfixture]. But it can also be run
  39 # by a regular [tclsh]. For these cases, emulate the [clock_milliseconds]
  40 # command.
  41 if {[info commands clock_milliseconds]==""} {
  42   proc clock_milliseconds {} {
  43     clock milliseconds
  44   }
  45 }
  46
  47 #-------------------------------------------------------------------------
  48 # Usage:
  49 #
  50 proc usage {} {
  51   set a0 [file tail $::argv0]
  52
  53   puts stderr [string trim [subst -nocommands {
  54 Usage:
  55     $a0 ?SWITCHES? ?PERMUTATION? ?PATTERNS?
  56     $a0 PERMUTATION FILE
  57     $a0 help
  58     $a0 njob ?NJOB?
  59     $a0 script ?-msvc? CONFIG
  60     $a0 status
  61
  62   where SWITCHES are:
  63     --buildonly              Build test exes but do not run tests
  64     --config CONFIGS         Only use configs on comma-separate list CONFIGS
  65     --dryrun                 Write what would have happened to testrunner.log
  66     --explain                Write summary to stdout
  67     --jobs NUM               Run tests using NUM separate processes
  68     --omit CONFIGS           Omit configs on comma-separated list CONFIGS
  69     --stop-on-coredump       Stop running if any test segfaults
  70     --stop-on-error          Stop running after any reported error
  71     --zipvfs ZIPVFSDIR       ZIPVFS source directory
  72
  73 Special values for PERMUTATION that work with plain tclsh:
  74
  75     list      - show all allowed PERMUTATION arguments.
  76     mdevtest  - tests recommended prior to normal development check-ins.
  77     release   - full release test with various builds.
  78     sdevtest  - like mdevtest but using ASAN and UBSAN.
  79
  80 Other PERMUTATION arguments must be run using testfixture, not tclsh:
  81
  82     all       - all tcl test scripts, plus a subset of test scripts rerun
  83                 with various permutations.
  84     full      - all tcl test scripts.
  85     veryquick - a fast subset of the tcl test scripts. This is the default.
  86
  87 If no PATTERN arguments are present, all tests specified by the PERMUTATION
  88 are run. Otherwise, each pattern is interpreted as a glob pattern. Only
  89 those tcl tests for which the final component of the filename matches at
  90 least one specified pattern are run.
  91
  92 If no PATTERN arguments are present, then various fuzztest, threadtest
  93 and other tests are run as part of the "release" permutation. These are
  94 omitted if any PATTERN arguments are specified on the command line.
  95
  96 If a PERMUTATION is specified and is followed by the path to a Tcl script
  97 instead of a list of patterns, then that single Tcl test script is run
  98 with the specified permutation.
  99
 100 The "status" and "njob" commands are designed to be run from the same
 101 directory as a running testrunner.tcl script that is running tests. The
 102 "status" command prints a report describing the current state and progress
 103 of the tests. The "njob" command may be used to query or modify the number
 104 of sub-processes the test script uses to run tests.
 105
 106 The "script" command outputs the script used to build a configuration.
 107 Add the "-msvc" option for a Windows-compatible script. For a list of
 108 available configurations enter "$a0 script help".
 109
 110 Full documentation here: https://sqlite.org/src/doc/trunk/doc/testrunner.md
 111   }]]
 112
 113   exit 1
 114 }
 115 #-------------------------------------------------------------------------
 116
 117 #-------------------------------------------------------------------------
 118 # Try to estimate a the number of processes to use.
 119 #
 120 # Command [guess_number_of_cores] attempts to glean the number of logical
 121 # cores. Command [default_njob] returns the default value for the --jobs
 122 # switch.
 123 #
 124 proc guess_number_of_cores {} {
 125   if {[catch {number_of_cores} ret]} {
 126     set ret 4
 127
 128     if {$::tcl_platform(platform)=="windows"} {
 129       catch { set ret $::env(NUMBER_OF_PROCESSORS) }
 130     } else {
 131       if {$::tcl_platform(os)=="Darwin"} {
 132         set cmd "sysctl -n hw.logicalcpu"
 133       } else {
 134         set cmd "nproc"
 135       }
 136       catch {
 137         set fd [open "|$cmd" r]
 138         set ret [gets $fd]
 139         close $fd
 140         set ret [expr $ret]
 141       }
 142     }
 143   }
 144   return $ret
 145 }
 146
 147 proc default_njob {} {
 148   global env
 149   if {[info exists env(NJOB)] && $env(NJOB)>=1} {
 150     return $env(NJOB)
 151   }
 152   set nCore [guess_number_of_cores]
 153   if {$nCore<=2} {
 154     set nHelper 1
 155   } else {
 156     set nHelper [expr int($nCore*0.5)]
 157   }
 158   return $nHelper
 159 }
 160 #-------------------------------------------------------------------------
 161
 162 #-------------------------------------------------------------------------
 163 # Setup various default values in the global TRG() array.
 164 #
 165 set TRG(dbname) [file normalize testrunner.db]
 166 set TRG(logname) [file normalize testrunner.log]
 167 set TRG(build.logname) [file normalize testrunner_build.log]
 168 set TRG(info_script) [file normalize [info script]]
 169 set TRG(timeout) 10000              ;# Default busy-timeout for testrunner.db
 170 set TRG(nJob)    [default_njob]     ;# Default number of helper processes
 171 set TRG(patternlist) [list]
 172 set TRG(cmdline) $argv
 173 set TRG(reporttime) 2000
 174 set TRG(fuzztest) 0                 ;# is the fuzztest option present.
 175 set TRG(zipvfs) ""                  ;# -zipvfs option, if any
 176 set TRG(buildonly) 0                ;# True if --buildonly option
 177 set TRG(config) {}                  ;# Only build the named configurations
 178 set TRG(omitconfig) {}              ;# Do not build these configurations
 179 set TRG(dryrun) 0                   ;# True if --dryrun option
 180 set TRG(explain) 0                  ;# True for the --explain option
 181 set TRG(stopOnError) 0              ;# Stop running at first failure
 182 set TRG(stopOnCore) 0               ;# Stop on a core-dump
 183
 184 switch -nocase -glob -- $tcl_platform(os) {
 185   *darwin* {
 186     set TRG(platform)    osx
 187     set TRG(make)        make.sh
 188     set TRG(makecmd)     "bash make.sh"
 189     set TRG(testfixture) testfixture
 190     set TRG(shell)       sqlite3
 191     set TRG(run)         run.sh
 192     set TRG(runcmd)      "bash run.sh"
 193   }
 194   *linux* {
 195     set TRG(platform)    linux
 196     set TRG(make)        make.sh
 197     set TRG(makecmd)     "bash make.sh"
 198     set TRG(testfixture) testfixture
 199     set TRG(shell)       sqlite3
 200     set TRG(run)         run.sh
 201     set TRG(runcmd)      "bash run.sh"
 202   }
 203   *win* {
 204     set TRG(platform)    win
 205     set TRG(make)        make.bat
 206     set TRG(makecmd)     "call make.bat"
 207     set TRG(testfixture) testfixture.exe
 208     set TRG(shell)       sqlite3.exe
 209     set TRG(run)         run.bat
 210     set TRG(runcmd)      "run.bat"
 211   }
 212   default {
 213     error "cannot determine platform!"
 214   }
 215 }
 216 #-------------------------------------------------------------------------
 217
 218 #-------------------------------------------------------------------------
 219 # The database schema used by the testrunner.db database.
 220 #
 221 set TRG(schema) {
 222   DROP TABLE IF EXISTS jobs;
 223   DROP TABLE IF EXISTS config;
 224
 225   /*
 226   ** This table contains one row for each job that testrunner.tcl must run
 227   ** before the entire test run is finished.
 228   **
 229   ** jobid:
 230   **   Unique identifier for each job. Must be a +ve non-zero number.
 231   **
 232   ** displaytype:
 233   **   3 or 4 letter mnemonic for the class of tests this belongs to e.g.
 234   **   "fuzz", "tcl", "make" etc.
 235   **
 236   ** displayname:
 237   **   Name/description of job. For display purposes.
 238   **
 239   ** build:
 240   **   If the job requires a make.bat/make.sh make wrapper (i.e. to build
 241   **   something), the name of the build configuration it uses. See
 242   **   testrunner_data.tcl for a list of build configs. e.g. "Win32-MemDebug".
 243   **
 244   ** dirname:
 245   **   If the job should use a well-known directory name for its
 246   **   sub-directory instead of an anonymous "testdir[1234...]" sub-dir
 247   **   that is deleted after the job is finished.
 248   **
 249   ** cmd:
 250   **   Bash or batch script to run the job.
 251   **
 252   ** depid:
 253   **   The jobid value of a job that this job depends on. This job may not
 254   **   be run before its depid job has finished successfully.
 255   **
 256   ** priority:
 257   **   Higher values run first. Sometimes.
 258   */
 259   CREATE TABLE jobs(
 260     /* Fields populated when db is initialized */
 261     jobid INTEGER PRIMARY KEY,          -- id to identify job
 262     displaytype TEXT NOT NULL,          -- Type of test (for one line report)
 263     displayname TEXT NOT NULL,          -- Human readable job name
 264     build TEXT NOT NULL DEFAULT '',     -- make.sh/make.bat file request, if any
 265     dirname TEXT NOT NULL DEFAULT '',   -- directory name, if required
 266     cmd TEXT NOT NULL,                  -- shell command to run
 267     depid INTEGER,                      -- identifier of dependency (or '')
 268     priority INTEGER NOT NULL,          -- higher priority jobs may run earlier
 269
 270     /* Fields updated as jobs run */
 271     starttime INTEGER,
 272     endtime INTEGER,
 273     state TEXT CHECK( state IN ('','ready','running','done','failed','omit') ),
 274     output TEXT
 275   );
 276
 277   CREATE TABLE config(
 278     name TEXT COLLATE nocase PRIMARY KEY,
 279     value
 280   ) WITHOUT ROWID;
 281
 282   CREATE INDEX i1 ON jobs(state, priority);
 283   CREATE INDEX i2 ON jobs(depid);
 284 }
 285 #-------------------------------------------------------------------------
 286
 287 #--------------------------------------------------------------------------
 288 # Check if this script is being invoked to run a single file. If so,
 289 # run it.
 290 #
 291 if {[llength $argv]==2
 292  && ([lindex $argv 0]=="" || [info exists ::testspec([lindex $argv 0])])
 293  && [file exists [lindex $argv 1]]
 294 } {
 295   set permutation [lindex $argv 0]
 296   set script [file normalize [lindex $argv 1]]
 297   set ::argv [list]
 298
 299   set testdir [file dirname $argv0]
 300   source $::testdir/tester.tcl
 301
 302   if {$permutation=="full"} {
 303
 304     unset -nocomplain ::G(isquick)
 305     reset_db
 306
 307   } elseif {$permutation!="default" && $permutation!=""} {
 308
 309     if {[info exists ::testspec($permutation)]==0} {
 310       error "no such permutation: $permutation"
 311     }
 312
 313     array set O $::testspec($permutation)
 314     set ::G(perm:name)         $permutation
 315     set ::G(perm:prefix)       $O(-prefix)
 316     set ::G(isquick)           1
 317     set ::G(perm:dbconfig)     $O(-dbconfig)
 318     set ::G(perm:presql)       $O(-presql)
 319
 320     rename finish_test helper_finish_test
 321     proc finish_test {} "
 322       uplevel {
 323         $O(-shutdown)
 324       }
 325       helper_finish_test
 326     "
 327
 328     eval $O(-initialize)
 329   }
 330
 331   reset_db
 332   source $script
 333   exit
 334 }
 335 #--------------------------------------------------------------------------
 336
 337 #--------------------------------------------------------------------------
 338 # Check if this is the "njob" command:
 339 #
 340 if {([llength $argv]==2 || [llength $argv]==1)
 341  && [string compare -nocase njob [lindex $argv 0]]==0
 342 } {
 343   sqlite3 mydb $TRG(dbname)
 344   if {[llength $argv]==2} {
 345     set param [lindex $argv 1]
 346     if {[string is integer $param]==0 || $param<1 || $param>128} {
 347       puts stderr "parameter must be an integer between 1 and 128"
 348       exit 1
 349     }
 350
 351     mydb eval { REPLACE INTO config VALUES('njob', $param); }
 352   }
 353   set res [mydb one { SELECT value FROM config WHERE name='njob' }]
 354   mydb close
 355   puts "$res"
 356   exit
 357 }
 358 #--------------------------------------------------------------------------
 359
 360 #--------------------------------------------------------------------------
 361 # Check if this is the "help" command:
 362 #
 363 if {[string compare -nocase help [lindex $argv 0]]==0} {
 364   usage
 365 }
 366 #--------------------------------------------------------------------------
 367
 368 #--------------------------------------------------------------------------
 369 # Check if this is the "script" command:
 370 #
 371 if {[string compare -nocase script [lindex $argv 0]]==0} {
 372   if {[llength $argv]!=2 && !([llength $argv]==3&&[lindex $argv 1]=="-msvc")} {
 373     usage
 374   }
 375
 376   set bMsvc [expr ([llength $argv]==3)]
 377   set config [lindex $argv [expr [llength $argv]-1]]
 378
 379   puts [trd_buildscript $config [file dirname $testdir] $bMsvc]
 380   exit
 381 }
 382
 383
 384 #--------------------------------------------------------------------------
 385 # Check if this is the "status" command:
 386 #
 387 if {[llength $argv]==1
 388  && [string compare -nocase status [lindex $argv 0]]==0
 389 } {
 390
 391   proc display_job {jobdict {tm ""}} {
 392     array set job $jobdict
 393
 394     set dfname [format %-60s $job(displayname)]
 395
 396     set dtm ""
 397     if {$tm!=""} { set dtm "\[[expr {$tm-$job(starttime)}]ms\]" }
 398     puts "  $dfname $dtm"
 399   }
 400
 401   sqlite3 mydb $TRG(dbname)
 402   mydb timeout 1000
 403   mydb eval BEGIN
 404
 405   set cmdline [mydb one { SELECT value FROM config WHERE name='cmdline' }]
 406   set nJob [mydb one { SELECT value FROM config WHERE name='njob' }]
 407
 408   set now [clock_milliseconds]
 409   set tm [mydb one {
 410     SELECT
 411       COALESCE((SELECT value FROM config WHERE name='end'), $now) -
 412       (SELECT value FROM config WHERE name='start')
 413   }]
 414
 415   set total 0
 416   foreach s {"" ready running done failed} { set S($s) 0 }
 417   mydb eval {
 418     SELECT state, count(*) AS cnt FROM jobs GROUP BY 1
 419   } {
 420     incr S($state) $cnt
 421     incr total $cnt
 422   }
 423   set fin [expr $S(done)+$S(failed)]
 424   if {$cmdline!=""} {set cmdline " $cmdline"}
 425
 426   set f ""
 427   if {$S(failed)>0} {
 428     set f "$S(failed) FAILED, "
 429   }
 430   puts "Command line: \[testrunner.tcl$cmdline\]"
 431   puts "Jobs:         $nJob"
 432   puts "Summary:      ${tm}ms, ($fin/$total) finished, ${f}$S(running) running"
 433
 434   set srcdir [file dirname [file dirname $TRG(info_script)]]
 435   if {$S(running)>0} {
 436     puts "Running: "
 437     mydb eval {
 438       SELECT * FROM jobs WHERE state='running' ORDER BY starttime
 439     } job {
 440       display_job [array get job] $now
 441     }
 442   }
 443   if {$S(failed)>0} {
 444     puts "Failures: "
 445     mydb eval {
 446       SELECT * FROM jobs WHERE state='failed' ORDER BY starttime
 447     } job {
 448       display_job [array get job]
 449     }
 450     set nOmit [db one {SELECT count(*) FROM jobs WHERE state='omit'}]
 451     if {$nOmit} {
 452       puts "$nOmit jobs omitted due to failures"
 453     }
 454   }
 455
 456   mydb close
 457   exit
 458 }
 459
 460 #-------------------------------------------------------------------------
 461 # Parse the command line.
 462 #
 463 for {set ii 0} {$ii < [llength $argv]} {incr ii} {
 464   set isLast [expr $ii==([llength $argv]-1)]
 465   set a [lindex $argv $ii]
 466   set n [string length $a]
 467
 468   if {[string range $a 0 0]=="-"} {
 469     if {($n>2 && [string match "$a*" --jobs]) || $a=="-j"} {
 470       incr ii
 471       set TRG(nJob) [lindex $argv $ii]
 472       if {$isLast} { usage }
 473     } elseif {($n>2 && [string match "$a*" --zipvfs]) || $a=="-z"} {
 474       incr ii
 475       set TRG(zipvfs) [file normalize [lindex $argv $ii]]
 476       if {$isLast} { usage }
 477     } elseif {($n>2 && [string match "$a*" --buildonly]) || $a=="-b"} {
 478       set TRG(buildonly) 1
 479     } elseif {($n>2 && [string match "$a*" --config]) || $a=="-c"} {
 480       incr ii
 481       set TRG(config) [lindex $argv $ii]
 482     } elseif {($n>2 && [string match "$a*" --dryrun]) || $a=="-d"} {
 483       set TRG(dryrun) 1
 484     } elseif {($n>2 && [string match "$a*" --explain]) || $a=="-e"} {
 485       set TRG(explain) 1
 486     } elseif {($n>2 && [string match "$a*" --omit]) || $a=="-c"} {
 487       incr ii
 488       set TRG(omitconfig) [lindex $argv $ii]
 489     } elseif {[string match "$a*" --stop-on-error]} {
 490       set TRG(stopOnError) 1
 491     } elseif {[string match "$a*" --stop-on-coredump]} {
 492       set TRG(stopOnCore) 1
 493     } else {
 494       usage
 495     }
 496   } else {
 497     lappend TRG(patternlist) [string map {% *} $a]
 498   }
 499 }
 500 set argv [list]
 501
 502 # This script runs individual tests - tcl scripts or [make xyz] commands -
 503 # in directories named "testdir$N", where $N is an integer. This variable
 504 # contains a list of integers indicating the directories in use.
 505 #
 506 # This variable is accessed only via the following commands:
 507 #
 508 #   dirs_nHelper
 509 #     Return the number of entries currently in the list.
 510 #
 511 #   dirs_freeDir IDIR
 512 #     Remove value IDIR from the list. It is an error if it is not present.
 513 #
 514 #   dirs_allocDir
 515 #     Select a value that is not already in the list. Add it to the list
 516 #     and return it.
 517 #
 518 set TRG(dirs_in_use) [list]
 519
 520 proc dirs_nHelper {} {
 521   global TRG
 522   llength $TRG(dirs_in_use)
 523 }
 524 proc dirs_freeDir {iDir} {
 525   global TRG
 526   set out [list]
 527   foreach d $TRG(dirs_in_use) {
 528     if {$iDir!=$d} { lappend out $d }
 529   }
 530   if {[llength $out]!=[llength $TRG(dirs_in_use)]-1} {
 531     error "dirs_freeDir could not find $iDir"
 532   }
 533   set TRG(dirs_in_use) $out
 534 }
 535 proc dirs_allocDir {} {
 536   global TRG
 537   array set inuse [list]
 538   foreach d $TRG(dirs_in_use) {
 539     set inuse($d) 1
 540   }
 541   for {set iRet 0} {[info exists inuse($iRet)]} {incr iRet} { }
 542   lappend TRG(dirs_in_use) $iRet
 543   return $iRet
 544 }
 545
 546 # Check that directory $dir exists. If it does not, create it. If
 547 # it does, delete its contents.
 548 #
 549 proc create_or_clear_dir {dir} {
 550   set dir [file normalize $dir]
 551   catch { file mkdir $dir }
 552   foreach f [glob -nocomplain [file join $dir *]] {
 553     catch { file delete -force $f }
 554   }
 555 }
 556
 557 proc build_to_dirname {bname} {
 558   set fold [string tolower [string map {- _} $bname]]
 559   return "testrunner_build_$fold"
 560 }
 561
 562 #-------------------------------------------------------------------------
 563
 564 proc r_write_db {tcl} {
 565   trdb eval { BEGIN EXCLUSIVE }
 566   uplevel $tcl
 567   trdb eval { COMMIT }
 568 }
 569
 570 # Obtain a new job to be run by worker $iJob (an integer). A job is
 571 # returned as a three element list:
 572 #
 573 #    {$build $config $file}
 574 #
 575 proc r_get_next_job {iJob} {
 576   global T
 577
 578   if {($iJob%2)} {
 579     set orderby "ORDER BY priority ASC"
 580   } else {
 581     set orderby "ORDER BY priority DESC"
 582   }
 583
 584   set ret [list]
 585
 586   r_write_db {
 587     set query "
 588       SELECT * FROM jobs AS j WHERE state='ready' $orderby LIMIT 1
 589     "
 590     trdb eval $query job {
 591       set tm [clock_milliseconds]
 592       set T($iJob) $tm
 593       set jobid $job(jobid)
 594
 595       trdb eval {
 596         UPDATE jobs SET starttime=$tm, state='running' WHERE jobid=$jobid
 597       }
 598
 599       set ret [array get job]
 600     }
 601   }
 602
 603   return $ret
 604 }
 605
 606 #rename r_get_next_job r_get_next_job_r
 607 #proc r_get_next_job {iJob} {
 608   #puts [time { set res [r_get_next_job_r $iJob] }]
 609   #set res
 610 #}
 611
 612 # Usage:
 613 #
 614 #   add_job OPTION ARG OPTION ARG...
 615 #
 616 # where available OPTIONS are:
 617 #
 618 #   -displaytype
 619 #   -displayname
 620 #   -build
 621 #   -dirname
 622 #   -cmd
 623 #   -depid
 624 #   -priority
 625 #
 626 # Returns the jobid value for the new job.
 627 #
 628 proc add_job {args} {
 629
 630   set options {
 631       -displaytype -displayname -build -dirname
 632       -cmd -depid -priority
 633   }
 634
 635   # Set default values of options.
 636   set A(-dirname) ""
 637   set A(-depid)   ""
 638   set A(-priority) 0
 639   set A(-build)   ""
 640
 641   array set A $args
 642
 643   # Check all required options are present. And that no extras are present.
 644   foreach o $options {
 645     if {[info exists A($o)]==0} { error "missing required option $o" }
 646   }
 647   foreach o [array names A] {
 648     if {[lsearch -exact $options $o]<0} { error "unrecognized option: $o" }
 649   }
 650
 651   set state ""
 652   if {$A(-depid)==""} { set state ready }
 653
 654   trdb eval {
 655     INSERT INTO jobs(
 656       displaytype, displayname, build, dirname, cmd, depid, priority,
 657       state
 658     ) VALUES (
 659       $A(-displaytype),
 660       $A(-displayname),
 661       $A(-build),
 662       $A(-dirname),
 663       $A(-cmd),
 664       $A(-depid),
 665       $A(-priority),
 666       $state
 667     )
 668   }
 669
 670   trdb last_insert_rowid
 671 }
 672
 673 # Argument $build is either an empty string, or else a list of length 3
 674 # describing the job to build testfixture. In the usual form:
 675 #
 676 #    {ID DIRNAME DISPLAYNAME}
 677 #
 678 # e.g
 679 #
 680 #    {1 /home/user/sqlite/test/testrunner_bld_xyz All-Debug}
 681 #
 682 proc add_tcl_jobs {build config patternlist {shelldepid ""}} {
 683   global TRG
 684
 685   set topdir [file dirname $::testdir]
 686   set testrunner_tcl [file normalize [info script]]
 687
 688   if {$build==""} {
 689     set testfixture [info nameofexec]
 690   } else {
 691     set testfixture [file join [lindex $build 1] $TRG(testfixture)]
 692   }
 693   if {[lindex $build 2]=="Valgrind"} {
 694     set setvar "export OMIT_MISUSE=1\n"
 695     set testfixture "${setvar}valgrind -v --error-exitcode=1 $testfixture"
 696   }
 697
 698   # The ::testspec array is populated by permutations.test
 699   foreach f [dict get $::testspec($config) -files] {
 700
 701     if {[llength $patternlist]>0} {
 702       set bMatch 0
 703       foreach p $patternlist {
 704         if {[string match $p [file tail $f]]} {
 705           set bMatch 1
 706           break
 707         }
 708       }
 709       if {$bMatch==0} continue
 710     }
 711
 712     if {[file pathtype $f]!="absolute"} { set f [file join $::testdir $f] }
 713     set f [file normalize $f]
 714
 715     set displayname [string map [list $topdir/ {}] $f]
 716     if {$config=="full" || $config=="veryquick"} {
 717       set cmd "$testfixture $f"
 718     } else {
 719       set cmd "$testfixture $testrunner_tcl $config $f"
 720       set displayname "config=$config $displayname"
 721     }
 722     if {$build!=""} {
 723       set displayname "[lindex $build 2] $displayname"
 724     }
 725
 726     set lProp [trd_test_script_properties $f]
 727     set priority 0
 728     if {[lsearch $lProp slow]>=0} { set priority 2 }
 729     if {[lsearch $lProp superslow]>=0} { set priority 4 }
 730
 731     set depid [lindex $build 0]
 732     if {$shelldepid!="" && [lsearch $lProp shell]>=0} { set depid $shelldepid }
 733
 734     add_job                            \
 735         -displaytype tcl               \
 736         -displayname $displayname      \
 737         -cmd $cmd                      \
 738         -depid $depid                  \
 739         -priority $priority
 740   }
 741 }
 742
 743 proc add_build_job {buildname target {postcmd ""} {depid ""}} {
 744   global TRG
 745
 746   set dirname "[string tolower [string map {- _} $buildname]]_$target"
 747   set dirname "testrunner_bld_$dirname"
 748
 749   set cmd "$TRG(makecmd) $target"
 750   if {$postcmd!=""} {
 751     append cmd "\n"
 752     append cmd $postcmd
 753   }
 754
 755   set id [add_job                                \
 756     -displaytype bld                             \
 757     -displayname "Build $buildname ($target)"    \
 758     -dirname $dirname                            \
 759     -build $buildname                            \
 760     -cmd  $cmd                                   \
 761     -depid $depid                                \
 762     -priority 3
 763   ]
 764
 765   list $id [file normalize $dirname] $buildname
 766 }
 767
 768 proc add_shell_build_job {buildname dirname depid} {
 769   global TRG
 770
 771   if {$TRG(platform)=="win"} {
 772     set path [string map {/ \\} "$dirname/"]
 773     set copycmd "xcopy $TRG(shell) $path"
 774   } else {
 775     set copycmd "cp $TRG(shell) $dirname/"
 776   }
 777
 778   return [
 779     add_build_job $buildname $TRG(shell) $copycmd $depid
 780   ]
 781 }
 782
 783
 784 proc add_make_job {bld target} {
 785   global TRG
 786
 787   if {$TRG(platform)=="win"} {
 788     set path [string map {/ \\} [lindex $bld 1]]
 789     set cmd "xcopy /S $path\\* ."
 790   } else {
 791     set cmd "cp -r [lindex $bld 1]/* ."
 792   }
 793   append cmd "\n$TRG(makecmd) $target"
 794
 795   add_job                                       \
 796     -displaytype make                           \
 797     -displayname "[lindex $bld 2] make $target" \
 798     -cmd $cmd                                   \
 799     -depid [lindex $bld 0]                      \
 800     -priority 1
 801 }
 802
 803 proc add_fuzztest_jobs {buildname} {
 804
 805   foreach {interpreter scripts} [trd_fuzztest_data] {
 806     set subcmd [lrange $interpreter 1 end]
 807     set interpreter [lindex $interpreter 0]
 808
 809     set bld [add_build_job $buildname $interpreter]
 810     foreach {depid dirname displayname} $bld {}
 811
 812     foreach s $scripts {
 813
 814       # Fuzz data files fuzzdata1.db and fuzzdata2.db are larger than
 815       # the others. So ensure that these are run as a higher priority.
 816       set tail [file tail $s]
 817       if {$tail=="fuzzdata1.db" || $tail=="fuzzdata2.db"} {
 818         set priority 5
 819       } else {
 820         set priority 1
 821       }
 822
 823       add_job                                                   \
 824         -displaytype fuzz                                       \
 825         -displayname "$buildname $interpreter $tail"            \
 826         -depid $depid                                           \
 827         -cmd "[file join $dirname $interpreter] $subcmd $s"     \
 828         -priority $priority
 829     }
 830   }
 831 }
 832
 833 proc add_zipvfs_jobs {} {
 834   global TRG
 835   source [file join $TRG(zipvfs) test zipvfs_testrunner.tcl]
 836
 837   set bld [add_build_job Zipvfs $TRG(testfixture)]
 838   foreach s [zipvfs_testrunner_files] {
 839     set cmd "[file join [lindex $bld 1] $TRG(testfixture)] $s"
 840     add_job                                  \
 841         -displaytype tcl                     \
 842         -displayname "Zipvfs [file tail $s]" \
 843         -cmd $cmd                            \
 844         -depid [lindex $bld 0]
 845   }
 846
 847   set ::env(SQLITE_TEST_DIR) $::testdir
 848 }
 849
 850 # Used to add jobs for "mdevtest" and "sdevtest".
 851 #
 852 proc add_devtest_jobs {lBld patternlist} {
 853   global TRG
 854
 855   foreach b $lBld {
 856     set bld [add_build_job $b $TRG(testfixture)]
 857     add_tcl_jobs $bld veryquick $patternlist SHELL
 858     if {$patternlist==""} {
 859       add_fuzztest_jobs $b
 860     }
 861
 862     if {[trdb one "SELECT EXISTS (SELECT 1 FROM jobs WHERE depid='SHELL')"]} {
 863       set sbld [add_shell_build_job $b [lindex $bld 1] [lindex $bld 0]]
 864       set sbldid [lindex $sbld 0]
 865       trdb eval {
 866         UPDATE jobs SET depid=$sbldid WHERE depid='SHELL'
 867       }
 868     }
 869
 870   }
 871 }
 872
 873 # Check to ensure that the interpreter is a full-blown "testfixture"
 874 # build and not just a "tclsh".  If this is not the case, issue an
 875 # error message and exit.
 876 #
 877 proc must_be_testfixture {} {
 878   if {[lsearch [info commands] sqlite3_soft_heap_limit]<0} {
 879     puts "Use testfixture, not tclsh, for these arguments."
 880     exit 1
 881   }
 882 }
 883
 884 proc add_jobs_from_cmdline {patternlist} {
 885   global TRG
 886
 887   if {$TRG(zipvfs)!=""} {
 888     add_zipvfs_jobs
 889     if {[llength $patternlist]==0} return
 890   }
 891
 892   if {[llength $patternlist]==0} {
 893     set patternlist [list veryquick]
 894   }
 895
 896   set first [lindex $patternlist 0]
 897   switch -- $first {
 898     all {
 899       must_be_testfixture
 900       set patternlist [lrange $patternlist 1 end]
 901       set clist [trd_all_configs]
 902       foreach c $clist {
 903         add_tcl_jobs "" $c $patternlist
 904       }
 905     }
 906
 907     mdevtest {
 908       set config_set {
 909         All-O0
 910         All-Debug
 911       }
 912       add_devtest_jobs $config_set [lrange $patternlist 1 end]
 913     }
 914
 915     sdevtest {
 916       set config_set {
 917         All-Sanitize
 918         All-Debug
 919       }
 920       add_devtest_jobs $config_set [lrange $patternlist 1 end]
 921     }
 922
 923     release {
 924       set patternlist [lrange $patternlist 1 end]
 925       foreach b [trd_builds $TRG(platform)] {
 926         if {$TRG(config)!="" && ![regexp "\\y$b\\y" $TRG(config)]} continue
 927         if {[regexp "\\y$b\\y" $TRG(omitconfig)]} continue
 928         set bld [add_build_job $b $TRG(testfixture)]
 929         foreach c [trd_configs $TRG(platform) $b] {
 930           add_tcl_jobs $bld $c $patternlist
 931         }
 932
 933         if {$patternlist==""} {
 934           foreach e [trd_extras $TRG(platform) $b] {
 935             if {$e=="fuzztest"} {
 936               add_fuzztest_jobs $b
 937             } else {
 938               add_make_job $bld $e
 939             }
 940           }
 941         }
 942       }
 943     }
 944
 945     list {
 946       set allperm [array names ::testspec]
 947       lappend allperm all mdevtest sdevtest release list
 948       puts "Allowed values for the PERMUTATION argument: [lsort $allperm]"
 949       exit 0
 950     }
 951
 952     default {
 953       must_be_testfixture
 954       if {[info exists ::testspec($first)]} {
 955         add_tcl_jobs "" $first [lrange $patternlist 1 end]
 956       } else {
 957         add_tcl_jobs "" full $patternlist
 958       }
 959     }
 960   }
 961 }
 962
 963 proc make_new_testset {} {
 964   global TRG
 965
 966   r_write_db {
 967     trdb eval $TRG(schema)
 968     set nJob $TRG(nJob)
 969     set cmdline $TRG(cmdline)
 970     set tm [clock_milliseconds]
 971     trdb eval { REPLACE INTO config VALUES('njob', $nJob ); }
 972     trdb eval { REPLACE INTO config VALUES('cmdline', $cmdline ); }
 973     trdb eval { REPLACE INTO config VALUES('start', $tm ); }
 974
 975     add_jobs_from_cmdline $TRG(patternlist)
 976   }
 977
 978 }
 979
 980 proc mark_job_as_finished {jobid output state endtm} {
 981   r_write_db {
 982     if {$state=="failed"} {
 983       set childstate omit
 984     } else {
 985       set childstate ready
 986     }
 987     trdb eval {
 988       UPDATE jobs
 989         SET output=$output, state=$state, endtime=$endtm
 990         WHERE jobid=$jobid;
 991       UPDATE jobs SET state=$childstate WHERE depid=$jobid;
 992     }
 993   }
 994 }
 995
 996 proc script_input_ready {fd iJob jobid} {
 997   global TRG
 998   global O
 999   global T
1000
1001   if {[eof $fd]} {
1002     trdb eval { SELECT * FROM jobs WHERE jobid=$jobid } job {}
1003
1004     # If this job specified a directory name, then delete the run.sh/run.bat
1005     # file from it before continuing. This is because the contents of this
1006     # directory might be copied by some other job, and we don't want to copy
1007     # the run.sh file in this case.
1008     if {$job(dirname)!=""} {
1009       file delete -force [file join $job(dirname) $TRG(run)]
1010     }
1011
1012     set ::done 1
1013     fconfigure $fd -blocking 1
1014     set state "done"
1015     set rc [catch { close $fd } msg]
1016     if {$rc} {
1017       if {[info exists TRG(reportlength)]} {
1018         puts -nonewline "[string repeat " " $TRG(reportlength)]\r"
1019       }
1020       puts "FAILED: $job(displayname) ($iJob)"
1021       set state "failed"
1022       if {$TRG(stopOnError)} {
1023         puts "OUTPUT: $O($iJob)"
1024         exit 1
1025       }
1026       if {$TRG(stopOnCore) && [string first {core dumped} $O($iJob)]>0} {
1027         puts "OUTPUT: $O($iJob)"
1028         exit 1
1029       }
1030     }
1031
1032     set tm [clock_milliseconds]
1033     set jobtm [expr {$tm - $job(starttime)}]
1034
1035     puts $TRG(log) "### $job(displayname) ${jobtm}ms ($state)"
1036     puts $TRG(log) [string trim $O($iJob)]
1037
1038     mark_job_as_finished $jobid $O($iJob) $state $tm
1039
1040     dirs_freeDir $iJob
1041     launch_some_jobs
1042     incr ::wakeup
1043   } else {
1044     set rc [catch { gets $fd line } res]
1045     if {$rc} {
1046       puts "ERROR $res"
1047     }
1048     if {$res>=0} {
1049       append O($iJob) "$line\n"
1050     }
1051   }
1052
1053 }
1054
1055 proc dirname {ii} {
1056   return "testdir$ii"
1057 }
1058
1059 proc launch_another_job {iJob} {
1060   global TRG
1061   global O
1062   global T
1063
1064   set testfixture [info nameofexec]
1065   set script $TRG(info_script)
1066
1067   set O($iJob) ""
1068
1069   set jobdict [r_get_next_job $iJob]
1070   if {$jobdict==""} { return 0 }
1071   array set job $jobdict
1072
1073   set dir $job(dirname)
1074   if {$dir==""} { set dir [dirname $iJob] }
1075   create_or_clear_dir $dir
1076
1077   if {$job(build)!=""} {
1078     set srcdir [file dirname $::testdir]
1079     if {$job(build)=="Zipvfs"} {
1080       set script [zipvfs_testrunner_script]
1081     } else {
1082       set bWin [expr {$TRG(platform)=="win"}]
1083       set script [trd_buildscript $job(build) $srcdir $bWin]
1084     }
1085     set fd [open [file join $dir $TRG(make)] w]
1086     puts $fd $script
1087     close $fd
1088   }
1089
1090   # Add a batch/shell file command to set the directory used for temp
1091   # files to the test's working directory. Otherwise, tests that use
1092   # large numbers of temp files (e.g. zipvfs), might generate temp
1093   # filename collisions.
1094   if {$TRG(platform)=="win"} {
1095     set set_tmp_dir "SET SQLITE_TMPDIR=[file normalize $dir]"
1096   } else {
1097     set set_tmp_dir "export SQLITE_TMPDIR=\"[file normalize $dir]\""
1098   }
1099
1100   if { $TRG(dryrun) } {
1101
1102     mark_job_as_finished $job(jobid) "" done 0
1103     dirs_freeDir $iJob
1104     if {$job(build)!=""} {
1105       puts $TRG(log) "(cd $dir ; $job(cmd) )"
1106     } else {
1107       puts $TRG(log) "$job(cmd)"
1108     }
1109
1110   } else {
1111     set pwd [pwd]
1112     cd $dir
1113     set fd [open $TRG(run) w]
1114     puts $fd $set_tmp_dir
1115     puts $fd $job(cmd)
1116     close $fd
1117     set fd [open "|$TRG(runcmd) 2>@1" r]
1118     cd $pwd
1119
1120     fconfigure $fd -blocking false
1121     fileevent $fd readable [list script_input_ready $fd $iJob $job(jobid)]
1122   }
1123
1124   return 1
1125 }
1126
1127 proc one_line_report {} {
1128   global TRG
1129
1130   set tm [expr [clock_milliseconds] - $TRG(starttime)]
1131   set tm [format "%d" [expr int($tm/1000.0 + 0.5)]]
1132
1133   r_write_db {
1134     trdb eval {
1135       SELECT displaytype, state, count(*) AS cnt
1136       FROM jobs
1137       GROUP BY 1, 2
1138     } {
1139       set v($state,$displaytype) $cnt
1140       incr t($displaytype) $cnt
1141     }
1142   }
1143
1144   set text ""
1145   foreach j [lsort [array names t]] {
1146     foreach k {done failed running} { incr v($k,$j) 0 }
1147     set fin [expr $v(done,$j) + $v(failed,$j)]
1148     lappend text "${j}($fin/$t($j))"
1149     if {$v(failed,$j)>0} {
1150       lappend text "f$v(failed,$j)"
1151     }
1152     if {$v(running,$j)>0} {
1153       lappend text "r$v(running,$j)"
1154     }
1155   }
1156
1157   if {[info exists TRG(reportlength)]} {
1158     puts -nonewline "[string repeat " " $TRG(reportlength)]\r"
1159   }
1160   set report "${tm} [join $text { }]"
1161   set TRG(reportlength) [string length $report]
1162   if {[string length $report]<100} {
1163     puts -nonewline "$report\r"
1164     flush stdout
1165   } else {
1166     puts $report
1167   }
1168
1169   after $TRG(reporttime) one_line_report
1170 }
1171
1172 proc launch_some_jobs {} {
1173   global TRG
1174   set nJob [trdb one { SELECT value FROM config WHERE name='njob' }]
1175
1176   while {[dirs_nHelper]<$nJob} {
1177     set iDir [dirs_allocDir]
1178     if {0==[launch_another_job $iDir]} {
1179       dirs_freeDir $iDir
1180       break;
1181     }
1182   }
1183 }
1184
1185 proc run_testset {} {
1186   global TRG
1187   set ii 0
1188
1189   set TRG(starttime) [clock_milliseconds]
1190   set TRG(log) [open $TRG(logname) w]
1191
1192   launch_some_jobs
1193
1194   one_line_report
1195   while {[dirs_nHelper]>0} {
1196     after 500 {incr ::wakeup}
1197     vwait ::wakeup
1198   }
1199   close $TRG(log)
1200   one_line_report
1201
1202   r_write_db {
1203     set tm [clock_milliseconds]
1204     trdb eval { REPLACE INTO config VALUES('end', $tm ); }
1205     set nErr [trdb one {SELECT count(*) FROM jobs WHERE state='failed'}]
1206     if {$nErr>0} {
1207       puts "$nErr failures:"
1208       trdb eval {
1209         SELECT displayname FROM jobs WHERE state='failed'
1210       } {
1211         puts "FAILED: $displayname"
1212       }
1213     }
1214     set nOmit [trdb one {SELECT count(*) FROM jobs WHERE state='omit'}]
1215     if {$nOmit>0} {
1216       puts "$nOmit jobs skipped due to prior failures"
1217     }
1218   }
1219
1220   puts "\nTest database is $TRG(dbname)"
1221   puts "Test log is $TRG(logname)"
1222 }
1223
1224 # Handle the --buildonly option, if it was specified.
1225 #
1226 proc handle_buildonly {} {
1227   global TRG
1228   if {$TRG(buildonly)} {
1229     r_write_db {
1230       trdb eval { DELETE FROM jobs WHERE displaytype!='bld' }
1231     }
1232   }
1233 }
1234
1235 # Handle the --explain option.  Provide a human-readable
1236 # explanation of all the tests that are in the trdb database jobs
1237 # table.
1238 #
1239 proc explain_layer {indent depid} {
1240   global TRG
1241   if {$TRG(buildonly)} {
1242     set showtests 0
1243   } else {
1244     set showtests 1
1245   }
1246   trdb eval {SELECT jobid, displayname, displaytype, dirname
1247                FROM jobs WHERE depid=$depid ORDER BY displayname} {
1248     if {$displaytype=="bld"} {
1249       puts "${indent}$displayname in $dirname"
1250       explain_layer "${indent}   " $jobid
1251     } elseif {$showtests} {
1252       puts "${indent}[lindex $displayname end]"
1253     }
1254   }
1255 }
1256 proc explain_tests {} {
1257   explain_layer "" ""
1258 }
1259
1260 sqlite3 trdb $TRG(dbname)
1261 trdb timeout $TRG(timeout)
1262 set tm [lindex [time { make_new_testset }] 0]
1263 if {$TRG(explain)} {
1264   explain_tests
1265 } else {
1266   if {$TRG(nJob)>1} {
1267     puts "splitting work across $TRG(nJob) jobs"
1268   }
1269   puts "built testset in [expr $tm/1000]ms.."
1270   handle_buildonly
1271   run_testset
1272 }
1273 trdb close