1# See the file LICENSE for redistribution information. 2# 3# Copyright (c) 1996, 2013 Oracle and/or its affiliates. All rights reserved. 4# 5# Code to load up the tests in to the Queue database 6# $Id$ 7proc load_queue { file {dbdir RUNQUEUE} nitems } { 8 global serial_tests 9 global num_serial 10 global num_parallel 11 12 puts -nonewline "Loading run queue with $nitems items..." 13 flush stdout 14 15 set env [berkdb_env -create -lock -home $dbdir] 16 error_check_good dbenv [is_valid_env $env] TRUE 17 18 # Open two databases, one for tests that may be run 19 # in parallel, the other for tests we want to run 20 # while only a single process is testing. 21 set db [eval {berkdb_open -env $env -create \ 22 -mode 0644 -len 200 -queue queue.db} ] 23 error_check_good dbopen [is_valid_db $db] TRUE 24 set serialdb [eval {berkdb_open -env $env -create \ 25 -mode 0644 -len 200 -queue serialqueue.db} ] 26 error_check_good dbopen [is_valid_db $serialdb] TRUE 27 28 set fid [open $file] 29 30 set count 0 31 32 while { [gets $fid str] != -1 } { 33 set testarr($count) $str 34 incr count 35 } 36 37 # Randomize array of tests. 38 set rseed [pid] 39 berkdb srand $rseed 40 puts -nonewline "randomizing..." 41 flush stdout 42 for { set i 0 } { $i < $count } { incr i } { 43 set tmp $testarr($i) 44 45 set j [berkdb random_int $i [expr $count - 1]] 46 47 set testarr($i) $testarr($j) 48 set testarr($j) $tmp 49 } 50 51 if { [string compare ALL $nitems] != 0 } { 52 set maxload $nitems 53 } else { 54 set maxload $count 55 } 56 57 puts "loading..." 58 flush stdout 59 set num_serial 0 60 set num_parallel 0 61 for { set i 0 } { $i < $maxload } { incr i } { 62 set str $testarr($i) 63 # Push serial tests into serial testing db, others 64 # into parallel db. 65 if { [is_serial $str] } { 66 set ret [eval {$serialdb put -append $str}] 67 error_check_good put:serialdb [expr $ret > 0] 1 68 incr num_serial 69 } else { 70 set ret [eval {$db put -append $str}] 71 error_check_good put:paralleldb [expr $ret > 0] 1 72 incr num_parallel 73 } 74 } 75 76 error_check_good maxload $maxload [expr $num_serial + $num_parallel] 77 puts "Loaded $maxload records: $num_serial in serial,\ 78 $num_parallel in parallel." 79 close $fid 80 $db close 81 $serialdb close 82 $env close 83} 84 85proc init_runqueue { {dbdir RUNQUEUE} nitems list} { 86 87 if { [file exists $dbdir] != 1 } { 88 file mkdir $dbdir 89 } 90 puts "Creating test list..." 91 $list ALL -n 92 load_queue ALL.OUT $dbdir $nitems 93 file delete TEST.LIST 94 file rename ALL.OUT TEST.LIST 95} 96 97proc run_parallel { nprocs {list run_all} {nitems ALL} } { 98 global num_serial 99 global num_parallel 100 101 # Forcibly remove stuff from prior runs, if it's still there. 102 fileremove -f ./RUNQUEUE 103 set dirs [glob -nocomplain ./PARALLEL_TESTDIR.*] 104 set files [glob -nocomplain ALL.OUT.*] 105 foreach file $files { 106 fileremove -f $file 107 } 108 foreach dir $dirs { 109 fileremove -f $dir 110 } 111 112 set basename ./PARALLEL_TESTDIR 113 set queuedir ./RUNQUEUE 114 source ./include.tcl 115 116 mkparalleldirs $nprocs $basename $queuedir 117 118 init_runqueue $queuedir $nitems $list 119 120 set basedir [pwd] 121 set queuedir ../../[string range $basedir \ 122 [string last "/" $basedir] end]/$queuedir 123 124 # Run serial tests in parallel testdir 0. 125 run_queue 0 $basename.0 $queuedir serial $num_serial 126 127 set pidlist {} 128 # Run parallel tests in testdirs 1 through n. 129 for { set i 1 } { $i <= $nprocs } { incr i } { 130 set ret [catch { 131 set p [exec $tclsh_path << \ 132 "source $test_path/test.tcl; run_queue $i \ 133 $basename.$i $queuedir parallel $num_parallel" &] 134 lappend pidlist $p 135 set f [open $testdir/begin.$p w] 136 close $f 137 } res] 138 } 139 watch_procs $pidlist 300 1000000 140 141 set failed 0 142 for { set i 0 } { $i <= $nprocs } { incr i } { 143 if { [file exists ALL.OUT.$i] == 1 } { 144 puts -nonewline "Checking output from ALL.OUT.$i ... " 145 if { [check_output ALL.OUT.$i] == 1 } { 146 set failed 1 147 } 148 puts " done." 149 } 150 } 151 if { $failed == 0 } { 152 puts "Regression tests succeeded." 153 } else { 154 puts "Regression tests failed." 155 puts "Review UNEXPECTED OUTPUT lines above for errors." 156 puts "Complete logs found in ALL.OUT.x files" 157 } 158} 159 160proc run_queue { i rundir queuedir {qtype parallel} {nitems 0} } { 161 set builddir [pwd] 162 file delete $builddir/ALL.OUT.$i 163 cd $rundir 164 165 puts "Starting $qtype run_queue process $i (pid [pid])." 166 167 source ./include.tcl 168 global env 169 170 set dbenv [berkdb_env -create -lock -home $queuedir] 171 error_check_good dbenv [is_valid_env $dbenv] TRUE 172 173 if { $qtype == "parallel" } { 174 set db [eval {berkdb_open -env $dbenv \ 175 -mode 0644 -queue queue.db} ] 176 error_check_good dbopen [is_valid_db $db] TRUE 177 } elseif { $qtype == "serial" } { 178 set db [eval {berkdb_open -env $dbenv \ 179 -mode 0644 -queue serialqueue.db} ] 180 error_check_good serialdbopen [is_valid_db $db] TRUE 181 } else { 182 puts "FAIL: queue type $qtype not recognized" 183 } 184 185 set dbc [eval $db cursor] 186 error_check_good cursor [is_valid_cursor $dbc $db] TRUE 187 188 set count 0 189 set waitcnt 0 190 set starttime [timestamp -r] 191 192 while { $waitcnt < 5 } { 193 set line [$db get -consume] 194 if { [ llength $line ] > 0 } { 195 set cmd [lindex [lindex $line 0] 1] 196 set num [lindex [lindex $line 0] 0] 197 set o [open $builddir/ALL.OUT.$i a] 198 puts $o "\nExecuting record $num ([timestamp -w]):\n" 199 set tdir "TESTDIR.$i" 200 regsub -all {TESTDIR} $cmd $tdir cmd 201 puts $o $cmd 202 close $o 203 if { [expr {$num % 10} == 0] && $nitems != 0 } { 204 puts -nonewline \ 205 "Starting test $num of $nitems $qtype items. " 206 set now [timestamp -r] 207 set elapsed_secs [expr $now - $starttime] 208 set secs_per_test [expr $elapsed_secs / $num] 209 set esttotal [expr $nitems * $secs_per_test] 210 set remaining [expr $esttotal - $elapsed_secs] 211 if { $remaining < 3600 } { 212 puts "\tRough guess: less than 1\ 213 hour left." 214 } else { 215 puts "\tRough guess: \ 216 [expr $remaining / 3600] hour(s) left." 217 } 218 } 219# puts "Process $i, record $num:\n$cmd" 220 set env(PURIFYOPTIONS) \ 221 "-log-file=./test$num.%p -follow-child-processes -messages=first" 222 set env(PURECOVOPTIONS) \ 223 "-counts-file=./cov.pcv -log-file=./cov.log -follow-child-processes" 224 if [catch {exec $tclsh_path \ 225 << "source $test_path/test.tcl; $cmd" \ 226 >>& $builddir/ALL.OUT.$i } res] { 227 set o [open $builddir/ALL.OUT.$i a] 228 puts $o "FAIL: '$cmd': $res" 229 close $o 230 } 231 env_cleanup $testdir 232 set o [open $builddir/ALL.OUT.$i a] 233 puts $o "\nEnding record $num ([timestamp])\n" 234 close $o 235 incr count 236 } else { 237 incr waitcnt 238 tclsleep 1 239 } 240 } 241 242 set now [timestamp -r] 243 set elapsed [expr $now - $starttime] 244 puts "Process $i: $count commands executed in [format %02u:%02u \ 245 [expr $elapsed / 3600] [expr ($elapsed % 3600) / 60]]" 246 247 error_check_good close_parallel_cursor_$i [$dbc close] 0 248 error_check_good close_parallel_db_$i [$db close] 0 249 error_check_good close_parallel_env_$i [$dbenv close] 0 250 251 # 252 # We need to put the pid file in the builddir's idea 253 # of testdir, not this child process' local testdir. 254 # Therefore source builddir's include.tcl to get its 255 # testdir. 256 # !!! This resets testdir, so don't do anything else 257 # local to the child after this. 258 source $builddir/include.tcl 259 260 set f [open $builddir/$testdir/end.[pid] w] 261 close $f 262 cd $builddir 263} 264 265proc mkparalleldirs { nprocs basename queuedir } { 266 source ./include.tcl 267 set dir [pwd] 268 269 if { $is_windows_test != 1 } { 270 set EXE "" 271 } else { 272 set EXE ".exe" 273 } 274 for { set i 0 } { $i <= $nprocs } { incr i } { 275 set destdir $basename.$i 276 catch {file mkdir $destdir} 277 puts "Created $destdir" 278 if { $is_windows_test == 1 } { 279 catch {file mkdir $destdir/$buildpath} 280 catch {eval file copy \ 281 [eval glob {$dir/$buildpath/*.dll}] $destdir/$buildpath} 282 catch {eval file copy \ 283 [eval glob {$dir/$buildpath/db_{checkpoint,deadlock}$EXE} \ 284 {$dir/$buildpath/db_{dump,load,printlog,recover,stat,upgrade}$EXE} \ 285 {$dir/$buildpath/db_{archive,verify,hotbackup,log_verify}$EXE}] \ 286 {$dir/$buildpath/dbkill$EXE} \ 287 $destdir/$buildpath} 288 catch {eval file copy \ 289 [eval glob -nocomplain {$dir/$buildpath/db_{reptest,repsite,replicate}$EXE}] \ 290 $destdir/$buildpath} 291 } 292 catch {eval file copy \ 293 [eval glob {$dir/{.libs,include.tcl}}] $destdir} 294 # catch {eval file copy $dir/$queuedir $destdir} 295 catch {eval file copy \ 296 [eval glob {$dir/db_{checkpoint,deadlock}$EXE} \ 297 {$dir/db_{dump,load,printlog,recover,stat,upgrade}$EXE} \ 298 {$dir/db_{archive,verify,hotbackup,log_verify}$EXE}] \ 299 $destdir} 300 catch {eval file copy \ 301 [eval glob -nocomplain {$dir/db_{reptest,repsite,replicate}$EXE}] $destdir} 302 303 # Create modified copies of include.tcl in parallel 304 # directories so paths still work. 305 306 set infile [open ./include.tcl r] 307 set d [read $infile] 308 close $infile 309 310 regsub {test_path } $d {test_path ../} d 311 regsub {src_root } $d {src_root ../} d 312 regsub {tcl_utils } $d {tcl_utils ../} d 313 set tdir "TESTDIR.$i" 314 regsub -all {TESTDIR} $d $tdir d 315 set outfile [open $destdir/include.tcl w] 316 puts $outfile $d 317 close $outfile 318 } 319} 320 321proc run_ptest { nprocs test args } { 322 global parms 323 global valid_methods 324 set basename ./PARALLEL_TESTDIR 325 set queuedir NULL 326 source ./include.tcl 327 328 mkparalleldirs $nprocs $basename $queuedir 329 330 if { [info exists parms($test)] } { 331 foreach method $valid_methods { 332 if { [eval exec_ptest $nprocs $basename \ 333 $test $method $args] != 0 } { 334 break 335 } 336 } 337 } else { 338 eval exec_ptest $nprocs $basename $test $args 339 } 340} 341 342proc exec_ptest { nprocs basename test args } { 343 source ./include.tcl 344 345 set basedir [pwd] 346 set pidlist {} 347 puts "Running $nprocs parallel runs of $test" 348 for { set i 1 } { $i <= $nprocs } { incr i } { 349 set outf ALL.OUT.$i 350 fileremove -f $outf 351 set ret [catch { 352 set p [exec $tclsh_path << \ 353 "cd $basename.$i;\ 354 source ../$test_path/test.tcl;\ 355 $test $args" >& $outf &] 356 lappend pidlist $p 357 set f [open $testdir/begin.$p w] 358 close $f 359 } res] 360 } 361 watch_procs $pidlist 30 36000 362 set failed 0 363 for { set i 1 } { $i <= $nprocs } { incr i } { 364 if { [check_output ALL.OUT.$i] == 1 } { 365 set failed 1 366 puts "Test $test failed in process $i." 367 } 368 } 369 if { $failed == 0 } { 370 puts "Test $test succeeded all processes" 371 return 0 372 } else { 373 puts "Test failed: stopping" 374 return 1 375 } 376} 377