Check-in [c075ebd51b]
Not logged in
Overview
SHA1 Hash:c075ebd51bcdb34062a39b7c46642be877740a6b
Date: 2011-06-15 18:11:59
User: mrwellan
Comment:Added -keepgoing, removed the calls to run-queue, fixes to job limits, -runstep, and killreq (now will do signal/kill after first trying signal/term)
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified dashboard.scm from [78e2859a5dd5f60b] to [d72b4fee0f77d68f].

179 (iup:button "Cancel and close" 179 (iup:button "Cancel and close" 180 #:expand "YES" 180 #:expand "YES" 181 #:action (lambda (x) 181 #:action (lambda (x) 182 (hash-table-dele 182 (hash-table-dele 183 (iup:destroy! se 183 (iup:destroy! se 184 ))) 184 ))) 185 (iup:hbox ;; the test steps are tracked here 185 (iup:hbox ;; the test steps are tracked here 186 (let ((stepsdat (iup:label "Test steps ...................... | 186 (let ((stepsdat (iup:label "Test steps ...................... 187 (hash-table-set! widgets "Test Steps" stepsdat) 187 (hash-table-set! widgets "Test Steps" stepsdat) 188 stepsdat) 188 stepsdat) 189 )))) 189 )))) 190 (iup:show self) 190 (iup:show self) 191 )))) 191 )))) 192 192 193 (define (colors-similar? color1 color2) 193 (define (colors-similar? color1 color2) ................................................................................................................................................................................ 207 (tests (db-get-tests-for-run *db* run-id testnamepatt 207 (tests (db-get-tests-for-run *db* run-id testnamepatt 208 (key-vals (get-key-vals *db* run-id))) 208 (key-vals (get-key-vals *db* run-id))) 209 (if (> (length tests) maxtests) 209 (if (> (length tests) maxtests) 210 (set! maxtests (length tests))) 210 (set! maxtests (length tests))) 211 (set! result (cons (vector run tests key-vals) result)))) 211 (set! result (cons (vector run tests key-vals) result)))) 212 runs) 212 runs) 213 (set! *header* header) 213 (set! *header* header) 214 (set! *allruns* (reverse result)) | 214 (set! *allruns* result) 215 maxtests)) 215 maxtests)) 216 216 217 (define (update-labels uidat) 217 (define (update-labels uidat) 218 (let* ((rown 0) 218 (let* ((rown 0) 219 (lftcol (vector-ref uidat 0)) 219 (lftcol (vector-ref uidat 0)) 220 (maxn (- (vector-length lftcol) 1))) 220 (maxn (- (vector-length lftcol) 1))) 221 (let loop ((i 0)) 221 (let loop ((i 0)) ................................................................................................................................................................................ 240 (update-labels uidat) 240 (update-labels uidat) 241 (for-each 241 (for-each 242 (lambda (popup) 242 (lambda (popup) 243 (let* ((test-id (car popup)) 243 (let* ((test-id (car popup)) 244 (widgets (hash-table-ref *examine-test-dat* popup)) 244 (widgets (hash-table-ref *examine-test-dat* popup)) 245 (stepslbl (hash-table-ref/default widgets "Test Steps" #f))) 245 (stepslbl (hash-table-ref/default widgets "Test Steps" #f))) 246 (if stepslbl 246 (if stepslbl 247 (let* ((fmtstr "~15a~8a~8a~17a") | 247 (let* ((fmtstr "~15a~8a~8a~20a") 248 (newtxt (string-intersperse 248 (newtxt (string-intersperse 249 (append 249 (append 250 (list 250 (list 251 (format #f fmtstr "Stepname" "State" "Status" "E 251 (format #f fmtstr "Stepname" "State" "Status" "E 252 (format #f fmtstr "========" "=====" "======" "= 252 (format #f fmtstr "========" "=====" "======" "= 253 (map (lambda (x) 253 (map (lambda (x) 254 ;; take advantage of the \n on time->strin 254 ;; take advantage of the \n on time->strin

Modified db.scm from [e509962d692c4e15] to [617661873021dd04].

219 (let ((res 0)) 219 (let ((res 0)) 220 (sqlite3:for-each-row 220 (sqlite3:for-each-row 221 (lambda (count) 221 (lambda (count) 222 (set! res count)) 222 (set! res count)) 223 db 223 db 224 "SELECT count(id) FROM tests WHERE state = 'RUNNING' OR state = 'LAUNCHED' 224 "SELECT count(id) FROM tests WHERE state = 'RUNNING' OR state = 'LAUNCHED' 225 res)) 225 res)) > 226 > 227 ;; done with run when: > 228 ;; 0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING > 229 (define (db:estimated-tests-remaining db run-id) > 230 (let ((res 0)) > 231 (sqlite3:for-each-row > 232 (lambda (count) > 233 (set! res count)) > 234 db > 235 "SELECT count(id) FROM tests WHERE state in ('LAUNCHED','NOT_STARTED','REMO > 236 res)) 226 237 227 ;; NB// Sync this with runs:get-test-info 238 ;; NB// Sync this with runs:get-test-info 228 (define (db:get-test-info db run-id testname item-path) 239 (define (db:get-test-info db run-id testname item-path) 229 (let ((res '())) 240 (let ((res '())) 230 (sqlite3:for-each-row 241 (sqlite3:for-each-row 231 (lambda (id run-id testname state status event-time host cpuload diskfree u 242 (lambda (id run-id testname state status event-time host cpuload diskfree u 232 (set! res (vector id run-id testname state status event-time host cpuload 243 (set! res (vector id run-id testname state status event-time host cpuload ................................................................................................................................................................................ 270 281 271 (define (db-get-test-steps-for-run db test-id) 282 (define (db-get-test-steps-for-run db test-id) 272 (let ((res '())) 283 (let ((res '())) 273 (sqlite3:for-each-row 284 (sqlite3:for-each-row 274 (lambda (id test-id stepname state status event-time) 285 (lambda (id test-id stepname state status event-time) 275 (set! res (cons (vector id test-id stepname state status event-time) res) 286 (set! res (cons (vector id test-id stepname state status event-time) res) 276 db 287 db 277 "SELECT id,test_id,stepname,state,status,event_time FROM test_steps WHERE t | 288 "SELECT id,test_id,stepname,state,status,event_time FROM test_steps WHERE t 278 test-id) 289 test-id) 279 res)) | 290 (reverse res))) 280 291 281 ;; check that *all* the prereqs are "COMPLETED" 292 ;; check that *all* the prereqs are "COMPLETED" 282 (define (db-get-prereqs-met db run-id waiton) 293 (define (db-get-prereqs-met db run-id waiton) 283 (let ((res #f) 294 (let ((res #f) 284 (not-complete 0) 295 (not-complete 0) 285 (tests (db-get-tests-for-run db run-id))) 296 (tests (db-get-tests-for-run db run-id))) 286 (for-each 297 (for-each

Modified megatest.scm from [7e0b50a664905c41] to [69c49cdbf1ae7a69].

4 ;; greater. See the accompanying file COPYING for details. 4 ;; greater. See the accompanying file COPYING for details. 5 ;; 5 ;; 6 ;; This program is distributed WITHOUT ANY WARRANTY; without even the 6 ;; This program is distributed WITHOUT ANY WARRANTY; without even the 7 ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 7 ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR 8 ;; PURPOSE. 8 ;; PURPOSE. 9 9 10 (include "common.scm") 10 (include "common.scm") 11 (define megatest-version 1.11) | 11 (define megatest-version 1.12) 12 12 13 (define help (conc " 13 (define help (conc " 14 Megatest, documentation at http://www.kiatoa.com/fossils/megatest 14 Megatest, documentation at http://www.kiatoa.com/fossils/megatest 15 version " megatest-version " 15 version " megatest-version " 16 license GPL, Copyright Matt Welland 2006-2011 16 license GPL, Copyright Matt Welland 2006-2011 17 17 18 Usage: megatest [options] 18 Usage: megatest [options] ................................................................................................................................................................................ 46 46 47 Misc 47 Misc 48 -force : override some checks 48 -force : override some checks 49 -xterm : start an xterm instead of launching the test 49 -xterm : start an xterm instead of launching the test 50 -remove-runs : remove the data for a run, requires fields, :runname 50 -remove-runs : remove the data for a run, requires fields, :runname 51 and -testpatt 51 and -testpatt 52 -testpatt patt : remove tests matching patt (requires -remove-runs) 52 -testpatt patt : remove tests matching patt (requires -remove-runs) > 53 -keepgoing : continue running until no jobs are \"LAUNCHED\" or > 54 \"NOT_STARTED\" 53 55 54 Helpers 56 Helpers 55 -runstep stepname ... : take remaining params as comand and execute as stepn 57 -runstep stepname ... : take remaining params as comand and execute as stepn 56 log will be in stepname.log. Best to put command in 58 log will be in stepname.log. Best to put command in 57 -logpro file : with -exec apply logpro file to stepname.log, create 59 -logpro file : with -exec apply logpro file to stepname.log, create 58 stepname.html and sets log to same 60 stepname.html and sets log to same 59 If using make use stepname_logpro.log as your target 61 If using make use stepname_logpro.log as your target ................................................................................................................................................................................ 88 "-force" 90 "-force" 89 "-xterm" 91 "-xterm" 90 "-showkeys" 92 "-showkeys" 91 "-test-status" 93 "-test-status" 92 "-gui" 94 "-gui" 93 "-runall" ;; run all tests 95 "-runall" ;; run all tests 94 "-remove-runs" 96 "-remove-runs" > 97 "-keepgoing" 95 ) 98 ) 96 args:arg-hash 99 args:arg-hash 97 0)) 100 0)) 98 101 99 (if (args:get-arg "-h") 102 (if (args:get-arg "-h") 100 (begin 103 (begin 101 (print help) 104 (print help) ................................................................................................................................................................................ 252 (print "ERROR: Attempted to run a test but run area config file 255 (print "ERROR: Attempted to run a test but run area config file 253 (exit 1)) 256 (exit 1)) 254 ;; put test parameters into convenient variables 257 ;; put test parameters into convenient variables 255 (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored fo 258 (let* ((test-names (get-all-legal-tests))) ;; "PROD" is ignored fo 256 (print "INFO: Attempting to start the following tests...") 259 (print "INFO: Attempting to start the following tests...") 257 (print " " (string-intersperse test-names ",")) 260 (print " " (string-intersperse test-names ",")) 258 (run-tests db test-names))) 261 (run-tests db test-names))) 259 (run-waiting-tests db) | 262 ;; (run-waiting-tests db) 260 (sqlite3:finalize! db) 263 (sqlite3:finalize! db) 261 (set! *didsomething* #t)))) 264 (set! *didsomething* #t)))) 262 265 263 ;;====================================================================== 266 ;;====================================================================== 264 ;; run one test 267 ;; run one test 265 ;;====================================================================== 268 ;;====================================================================== 266 269 ................................................................................................................................................................................ 293 (print "ERROR: Attempted to run a test but run area config file no 296 (print "ERROR: Attempted to run a test but run area config file no 294 (exit 1)) 297 (exit 1)) 295 ;; put test parameters into convenient variables 298 ;; put test parameters into convenient variables 296 (let* ((test-names (string-split (args:get-arg "-runtests") ","))) 299 (let* ((test-names (string-split (args:get-arg "-runtests") ","))) 297 (run-tests db test-names))) 300 (run-tests db test-names))) 298 ;; run-waiting-tests db) 301 ;; run-waiting-tests db) 299 (sqlite3:finalize! db) 302 (sqlite3:finalize! db) 300 (run-waiting-tests #f) | 303 ;; (run-waiting-tests #f) 301 (set! *didsomething* #t)))) 304 (set! *didsomething* #t)))) 302 305 303 (if (args:get-arg "-runtests") 306 (if (args:get-arg "-runtests") 304 (runtests)) 307 (runtests)) 305 308 306 ;;====================================================================== 309 ;;====================================================================== 307 ;; execute the test 310 ;; execute the test ................................................................................................................................................................................ 389 (- 392 (- 390 (current-seconds) 393 (current-seconds) 391 start-seconds))))) 394 start-seconds))))) 392 (let loop ((minutes (calc-minutes))) 395 (let loop ((minutes (calc-minutes))) 393 (let ((db (open-db))) 396 (let ((db (open-db))) 394 (set! kill-job? (test-get-kill-request 397 (set! kill-job? (test-get-kill-request 395 (test-update-meta-info db run-id test-n 398 (test-update-meta-info db run-id test-n > 399 (if kill-job? > 400 (begin 396 (if kill-job? (process-signal (vector-r | 401 (process-signal (vector-ref exit- > 402 (sleep 2) > 403 (handle-exceptions > 404 exn > 405 (print "ERROR: Problem killing p > 406 (process-signal (vector-ref exit 397 (sqlite3:finalize! db) 407 (sqlite3:finalize! db) 398 (thread-sleep! (+ 8 (random 4))) ;; add 408 (thread-sleep! (+ 8 (random 4))) ;; add 399 (loop (calc-minutes))))))) 409 (loop (calc-minutes))))))) 400 (th1 (make-thread monitorjob)) 410 (th1 (make-thread monitorjob)) 401 (th2 (make-thread runit))) 411 (th2 (make-thread runit))) 402 (thread-start! th1) 412 (thread-start! th1) 403 (thread-start! th2) 413 (thread-start! th2) ................................................................................................................................................................................ 500 (redir (case (string->symbol shell) 510 (redir (case (string->symbol shell) 501 ((tcsh csh ksh) ">&") 511 ((tcsh csh ksh) ">&") 502 ((zsh bash sh ash) "2>&1 >"))) 512 ((zsh bash sh ash) "2>&1 >"))) 503 (fullcmd (conc "(" (string-intersperse 513 (fullcmd (conc "(" (string-intersperse 504 (cons cmd params) " ") 514 (cons cmd params) " ") 505 ") " redir " " logfile))) 515 ") " redir " " logfile))) 506 ;; mark the start of the test 516 ;; mark the start of the test 507 (test-set-status! db run-id test-name "start" "n/a" itemdat | 517 (teststep-set-status! db run-id test-name stepname "start" " 508 ;; close the db 518 ;; close the db 509 (sqlite3:finalize! db) 519 (sqlite3:finalize! db) 510 ;; run the test step 520 ;; run the test step 511 (print "INFO: Running \"" fullcmd "\"") 521 (print "INFO: Running \"" fullcmd "\"") 512 (change-directory startingdir) 522 (change-directory startingdir) 513 (set! exitstat (system fullcmd)) ;; cmd params)) 523 (set! exitstat (system fullcmd)) ;; cmd params)) 514 (set! *globalexitstatus* exitstat) 524 (set! *globalexitstatus* exitstat)

Modified runs.scm from [a13e1910a3378aca] to [4be3851e9e3a8974].

248 tests) 248 tests) 249 res)) 249 res)) 250 250 251 (define (run-tests db test-names) 251 (define (run-tests db test-names) 252 (let* ((keys (db-get-keys db)) 252 (let* ((keys (db-get-keys db)) 253 (keyvallst (keys->vallist keys #t)) 253 (keyvallst (keys->vallist keys #t)) 254 (run-id (register-run db keys))) ;; test-name))) 254 (run-id (register-run db keys))) ;; test-name))) > 255 (let loop ((numtimes 0)) 255 (for-each | 256 (for-each 256 (lambda (test-name) | 257 (lambda (test-name) 257 (let ((num-running (db:get-count-tests-running db)) | 258 (let ((num-running (db:get-count-tests-running db)) 258 (max-concurrent-jobs (config-lookup *configdat* "setup" "max_concur | 259 (max-concurrent-jobs (config-lookup *configdat* "setup" "max_conc 259 (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " nu | 260 (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " 260 (if (or (not max-concurrent-jobs) | 261 (if (or (not max-concurrent-jobs) 261 (and max-concurrent-jobs | 262 (and max-concurrent-jobs 262 (string->number max-concurrent-jobs) | 263 (string->number max-concurrent-jobs) 263 (not (> num-running (string->number max-concurrent-jobs))) | 264 (not (>= num-running (string->number max-concurrent-jobs 264 (run-one-test db run-id test-name keyvallst) | 265 (run-one-test db run-id test-name keyvallst) 265 (print "WARNING: Max running jobs exceeded, current number running: | 266 (print "WARNING: Max running jobs exceeded, current number runnin 266 ", max_concurrent_jobs: " max-concurrent-jobs)))) | 267 ", max_concurrent_jobs: " max-concurrent-jobs)))) 267 test-names))) | 268 test-names) > 269 (if (args:get-arg "-keepgoing") > 270 (let ((estrem (db:estimated-tests-remaining db run-id))) > 271 (if (> estrem 0) > 272 (begin > 273 (print "Keep going, estimated " estrem " tests remaining to ru > 274 (sleep 10) > 275 (loop (+ numtimes 1))))))))) 268 276 269 ;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc 277 ;; VERY INEFFICIENT! Move stuff that should be done once up to calling proc 270 (define (run-one-test db run-id test-name keyvallst) 278 (define (run-one-test db run-id test-name keyvallst) 271 (print "Launching test " test-name) 279 (print "Launching test " test-name) 272 ;; All these vars might be referenced by the testconfig file reader 280 ;; All these vars might be referenced by the testconfig file reader 273 (setenv "MT_TEST_NAME" test-name) ;; 281 (setenv "MT_TEST_NAME" test-name) ;; 274 (setenv "MT_RUNNAME" (args:get-arg ":runname")) 282 (setenv "MT_RUNNAME" (args:get-arg ":runname")) ................................................................................................................................................................................ 305 (test-status #f) 313 (test-status #f) 306 (num-running (db:get-count-tests-running db)) 314 (num-running (db:get-count-tests-running db)) 307 (max-concurrent-jobs (config-lookup *configdat* "setup" "max_ 315 (max-concurrent-jobs (config-lookup *configdat* "setup" "max_ 308 (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: 316 (print "max-concurrent-jobs: " max-concurrent-jobs ", num-running: 309 (if (not (or (not max-concurrent-jobs) 317 (if (not (or (not max-concurrent-jobs) 310 (and max-concurrent-jobs 318 (and max-concurrent-jobs 311 (string->number max-concurrent-jobs) 319 (string->number max-concurrent-jobs) 312 (not (> num-running (string->number max-concurre | 320 (not (>= num-running (string->number max-concurr 313 (print "WARNING: Max running jobs exceeded, current number run 321 (print "WARNING: Max running jobs exceeded, current number run 314 ", max_concurrent_jobs: " max-concurrent-jobs) 322 ", max_concurrent_jobs: " max-concurrent-jobs) 315 (begin 323 (begin 316 (let loop2 ((ts #f) 324 (let loop2 ((ts #f) 317 (ct 0)) 325 (ct 0)) 318 (if (and (not ts) 326 (if (and (not ts) 319 (< ct 10)) 327 (< ct 10))

Modified tests/Makefile from [4c07feade78035be] to [0b961aa417fcf512].

1 # run some tests 1 # run some tests 2 2 3 MEGATEST=$(shell realpath ../megatest) 3 MEGATEST=$(shell realpath ../megatest) 4 4 5 runall : 5 runall : 6 cd ../;make 6 cd ../;make 7 $(MEGATEST) -runall :sysname ubuntu :fsname nfs :datapath none :runname | 7 $(MEGATEST) -keepgoing -runall :sysname ubuntu :fsname nfs :datapath non 8 8 9 test : 9 test : 10 cd ../;make test 10 cd ../;make test 11 make runall 11 make runall 12 12 13 dashboard : 13 dashboard : 14 cd ../;make dashboard 14 cd ../;make dashboard

Modified tests/megatest.config from [b996a05181a3c85b] to [7cce1c983316acca].

1 [fields] 1 [fields] 2 sysname TEXT 2 sysname TEXT 3 fsname TEXT 3 fsname TEXT 4 datapath TEXT 4 datapath TEXT 5 5 6 [setup] 6 [setup] 7 # exectutable /path/to/megatest 7 # exectutable /path/to/megatest 8 max_concurrent_jobs 405 | 8 max_concurrent_jobs 8 9 runsdir /tmp/runs 9 runsdir /tmp/runs 10 10 11 [jobtools] 11 [jobtools] 12 # ## launcher launches jobs, the job is managed on the target host 12 # ## launcher launches jobs, the job is managed on the target host 13 ## by megatest, comment out launcher to run local 13 ## by megatest, comment out launcher to run local 14 # workhosts localhost hermes 14 # workhosts localhost hermes 15 launcher nbfake 15 launcher nbfake