Index: configf.scm ================================================================== --- configf.scm +++ configf.scm @@ -269,11 +269,11 @@ (let ((sectdat (hash-table-ref/default cfgdat section '()))) (if (null? sectdat) '() (map car sectdat)))) -(define (configf:get-section cfdat section) +(define (configf:get-section cfgdat section) (hash-table-ref/default cfgdat section '())) (define (setup) (let* ((configf (find-config)) (config (if configf (read-config configf #f #t) #f))) Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -908,20 +908,20 @@ (debug:print-info 11 "db:get-tests-for-run START run-id=" run-id ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) res)) ;; get a useful subset of the tests data (used in dashboard ;; use db:mintests-get-{id ,run_id,testname ...} -(define (db:get-tests-for-runs-mindata db run-ids testpatt states status) - (db:get-tests-for-runs db run-ids testpatt states status qryvals: "id,run_id,testname,state,status,event_time,item_path")) +(define (db:get-tests-for-runs-mindata db run-ids testpatt states status not-in) + (db:get-tests-for-runs db run-ids testpatt states status not-in: not-in qryvals: "id,run_id,testname,state,status,event_time,item_path")) ;; NB // This is get tests for "runs" (note the plural!!) ;; ;; states and statuses are lists, turn them into ("PASS","FAIL"...) and use NOT IN ;; i.e. these lists define what to NOT show. ;; states and statuses are required to be lists, empty is ok ;; not-in #t = above behaviour, #f = must match -;; run-ids is a list of run-ids or a single number +;; run-ids is a list of run-ids or a single number or #f for all runs (define (db:get-tests-for-runs db run-ids testpatt states statuses #!key (not-in #t) (sort-by #f) (qryvals "id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment")) ;; 'rundir 'event_time (debug:print-info 11 "db:get-tests-for-run START run-ids=" run-ids ", testpatt=" testpatt ", states=" states ", statuses=" statuses ", not-in=" not-in ", sort-by=" sort-by) @@ -941,15 +941,15 @@ " IN ('" (string-intersperse statuses "','") "')"))) (tests-match-qry (tests:match->sqlqry testpatt)) (qry (conc "SELECT " qryvals - " FROM tests WHERE state != 'DELETED' AND " + " FROM tests WHERE state != 'DELETED' " (if run-ids (if (list? run-ids) - (conc " run_id in (" (string-intersperse (map conc run-ids) ",") ") ") - (conc "run_id=" run-ids " ")) + (conc "AND run_id IN (" (string-intersperse (map conc run-ids) ",") ") ") + (conc "AND run_id=" run-ids " ")) " ") ;; #f => run-ids don't filter on run-ids (if states-qry (conc " AND " states-qry) "") (if statuses-qry (conc " AND " statuses-qry) "") (if tests-match-qry (conc " AND (" tests-match-qry ") ") "") (case sort-by @@ -1053,11 +1053,11 @@ ;; speed up for common cases with a little logic (define (db:test-set-state-status-by-id db test-id newstate newstatus newcomment) (cond ((and newstate newstatus newcomment) - (sqlite3:exectute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus test-id)) + (sqlite3:execute db "UPDATE tests SET state=?,status=?,comment=? WHERE id=?;" newstate newstatus newcomment test-id)) ((and newstate newstatus) (sqlite3:execute db "UPDATE tests SET state=?,status=? WHERE id=?;" newstate newstatus test-id)) (else (if newstate (sqlite3:execute db "UPDATE tests SET state=? WHERE id=?;" newstate test-id)) (if newstatus (sqlite3:execute db "UPDATE tests SET status=? WHERE id=?;" newstatus test-id)) Index: dcommon.scm ================================================================== --- dcommon.scm +++ dcommon.scm @@ -146,11 +146,11 @@ ;; Now can calculate the run-ids (run-hash (hash-table-ref/default data get-runs-sig #f)) (run-ids (if run-hash (filter number? (hash-table-keys run-hash)) '())) - (test-changes (synchash:client-get 'db:get-tests-for-runs-mindata get-tests-sig 0 data run-ids testpatt states statuses)) + (test-changes (synchash:client-get 'db:get-tests-for-runs-mindata get-tests-sig 0 data run-ids testpatt states statuses #f)) (runs-hash (hash-table-ref/default data get-runs-sig #f)) (header (hash-table-ref/default runs-hash "header" #f)) (run-ids (sort (filter number? (hash-table-keys runs-hash)) (lambda (a b) (let* ((record-a (hash-table-ref runs-hash a)) Index: gutils.scm ================================================================== --- gutils.scm +++ gutils.scm @@ -24,16 +24,21 @@ (define (gutils:get-color-for-state-status state status);; #!key (get-label #f)) ;; ((if get-label cadr car) (case (string->symbol state) ((COMPLETED) - (if (equal? status "PASS") - '("70 249 73" "PASS") - (if (or (equal? status "WARN") - (equal? status "WAIVED")) - (list "255 172 13" status) - (list "223 33 49" status)))) ;; greenish orangeish redish + (case (string->symbol status) + ((PASS) (list "70 249 73" status)) + ((WARN WAIVED) (list "255 172 13" status)) + ((SKIP) (list "230 230 0" status)) + (else (list "223 33 49" status)))) + ;; (if (equal? status "PASS") + ;; '("70 249 73" "PASS") + ;; (if (or (equal? status "WARN") + ;; (equal? status "WAIVED")) + ;; (list "255 172 13" status) + ;; (list "223 33 49" status)))) ;; greenish orangeish redish ((LAUNCHED) (list "101 123 142" state)) ((CHECK) (list "255 100 50" state)) ((REMOTEHOSTSTART) (list "50 130 195" state)) ((RUNNING) (list "9 131 232" state)) ((KILLREQ) (list "39 82 206" state)) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -847,15 +847,34 @@ "\" and status \"" (test:get-status testdat) "\", use -rerun \"" (test:get-status testdat) "\" or -force to override")) ;; NOTE: No longer be checking prerequisites here! Will never get here unless prereqs are ;; already met. ;; This would be a great place to do the process-fork - (if (not (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat flags)) - (begin - (print "ERROR: Failed to launch the test. Exiting as soon as possible") - (set! *globalexitstatus* 1) ;; - (process-signal (current-process-id) signal/kill)))))) + ;; + (let ((skip-test #f) + (skip-check (configf:get-section test-conf "skip"))) + (cond + ;; Have to check for skip conditions. This one skips if there are same-named tests + ;; currently running + ((and skip-check + (configf:lookup test-conf "skip" "prevrunning")) + (let ((running-tests (cdb:remote-run db:get-tests-for-runs-mindata #f #f full-test-name '("RUNNING") '() #f))) + (if (not (null? running-tests)) ;; have to skip + (set! skip-test "Skipping due to previous tests running")))) + ((and skip-check + (configf:lookup test-conf "skip" "fileexists")) + (if (file-exists? (configf:lookup test-conf "skip" "fileexists")) + (set! skip-test (conc "Skipping due to existance of file " (configf:lookup test-conf "skip" "fileexists")))))) + (if skip-test + (begin + (cdb:remote-run db:test-set-state-status-by-id #f test-id "COMPLETED" "SKIP" skip-test) + (debug:info 1 "SKIPPING Test " test-full-name " due to " skip-test)) + (if (not (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat flags)) + (begin + (print "ERROR: Failed to launch the test. Exiting as soon as possible") + (set! *globalexitstatus* 1) ;; + (process-signal (current-process-id) signal/kill)))))))) ((KILLED) (debug:print 1 "NOTE: " full-test-name " is already running or was explictly killed, use -force to launch it.")) ((LAUNCHED REMOTEHOSTSTART RUNNING) (if (> (- (current-seconds)(+ (db:test-get-event_time testdat) (db:test-get-run_duration testdat))) Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -26,10 +26,14 @@ stopserver : cd ..;make && make install cd fullrun;$(MEGATEST) -stop-server 0 +repl : + cd ..;make && make install + cd fullrun;$(MEGATEST) -repl + test0 : cleanprep cd simplerun ; $(MEGATEST) -server - -debug $(DEBUG) test1 : cleanprep rm -f simplerun/megatest.db Index: tests/fdktestqa/testqa/tests/bigrun/testconfig ================================================================== --- tests/fdktestqa/testqa/tests/bigrun/testconfig +++ tests/fdktestqa/testqa/tests/bigrun/testconfig @@ -8,11 +8,10 @@ priority 0 # Iteration for your tests are controlled by the items section [items] NUMBER #{scheme (string-intersperse (map number->string (sort (let loop ((a 0)(res '()))(if (<= a (or (any->number (get-environment-variable "NUMTESTS")) 2500))(loop (+ a 1)(cons a res)) res)) <)) " ")} -# NUMBER #{shell xterm} # test_meta is a section for storing additional data on your test [test_meta] author matt owner matt Index: tests/fullrun/tests/priority_5/testconfig ================================================================== --- tests/fullrun/tests/priority_5/testconfig +++ tests/fullrun/tests/priority_5/testconfig @@ -2,10 +2,13 @@ runscript main.sh [requirements] priority 5 +[skip] +prevrunning #t + [test_meta] author matt owner bob description This test checks that a multi-lineitem test with mix of pass and non-fail rolls up a PASS