Index: .fossil-settings/ignore-glob ================================================================== --- .fossil-settings/ignore-glob +++ .fossil-settings/ignore-glob @@ -39,5 +39,8 @@ tests/megatest.db tests/fdktestqa/simplelinks/* tests/fdktestqa/testqa/megatest.db tests/fdktestqa/testqa/monitor.db megatest-fossil-hash.scm +tests/release/runs/* +tests/release/links/* +tests/release/megatest.db Index: api.scm ================================================================== --- api.scm +++ api.scm @@ -40,10 +40,11 @@ get-tests-for-run get-test-id get-tests-for-runs-mindata get-run-name-from-id get-runs + get-num-runs get-all-run-ids get-prev-run-ids get-run-ids-matching-target get-runs-by-patt get-steps-data @@ -174,10 +175,12 @@ ;;====================================================================== ;; KEYS ((get-key-val-pairs) (apply db:get-key-val-pairs dbstruct area-dat params)) ((get-keys) (db:get-keys dbstruct area-dat)) + ((get-key-vals) (apply db:get-key-vals dbstruct params)) + ((get-targets) (db:get-targets dbstruct)) ;; ARCHIVES ((test-get-archive-block-info) (apply db:test-get-archive-block-info dbstruct area-dat params)) ;; TESTS @@ -206,10 +209,11 @@ ((get-tests-for-run) (apply db:get-tests-for-run dbstruct area-dat params)) ((get-test-id) (apply db:get-test-id dbstruct area-dat params)) ((get-tests-for-run-mindata) (apply db:get-tests-for-run-mindata dbstruct area-dat params)) ((get-runs) (apply db:get-runs dbstruct area-dat params)) ((get-all-run-ids) (db:get-all-run-ids dbstruct area-dat)) + ((get-num-runs) (apply db:get-num-runs dbstruct params)) ((get-prev-run-ids) (apply db:get-prev-run-ids dbstruct area-dat params)) ((get-run-ids-matching-target) (apply db:get-run-ids-matching-target dbstruct area-dat params)) ((get-runs-by-patt) (apply db:get-runs-by-patt dbstruct area-dat params)) ((get-run-name-from-id) (apply db:get-run-name-from-id dbstruct area-dat params)) Index: bin/sleeprunner ================================================================== --- bin/sleeprunner +++ bin/sleeprunner @@ -1,7 +1,7 @@ #!/bin/bash if [[ $SLEEPRUNNER == "" ]];then -SLEEPRUNNER=1 +SLEEPRUNNER=0 fi echo "nbfake $@ &> /dev/null" | at now + $SLEEPRUNNER minutes &> /dev/null Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -428,27 +428,30 @@ ;;====================================================================== ;; T A R G E T S ;;====================================================================== (define (common:args-get-target #!key (split #f)) - (let* ((target (if (args:get-arg "-reqtarg") + (let* ((keys (keys:config-get-fields *configdat*)) + (numkeys (length keys)) + (target (if (args:get-arg "-reqtarg") (args:get-arg "-reqtarg") (if (args:get-arg "-target") (args:get-arg "-target") (getenv "MT_TARGET")))) (tlist (if target (string-split target "/" #t) '())) (valid (if target (and (not (null? tlist)) + (eq? numkeys (length tlist)) (null? (filter string-null? tlist))) #f))) (if valid (if split tlist target) (if target (begin - (debug:print 0 "ERROR: Invalid target, spaces or blanks not allowed \"" target "\"") + (debug:print 0 "ERROR: Invalid target, spaces or blanks not allowed \"" target "\", target should be: " (string-intersperse keys "/")) #f) #f)))) ;;====================================================================== ;; M I S C L I S T S Index: dashboard-tests.scm ================================================================== --- dashboard-tests.scm +++ dashboard-tests.scm @@ -95,11 +95,11 @@ (lambda (testdat) (let ((newcomment (db:test-get-comment testdat))) (if *dashboard-comment-share-slot* (if (not (equal? (iup:attribute *dashboard-comment-share-slot* "VALUE") newcomment)) - (iup:attribute-set! *dashboard-comment-slot* + (iup:attribute-set! *dashboard-comment-share-slot* "VALUE" newcomment))) newcomment))) (store-label "testid" (iup:label "TestId " @@ -418,18 +418,18 @@ (keydat (if testdat (db:get-key-val-pairs dbstruct run-id) #f)) (rundat (if testdat (db:get-run-info dbstruct run-id) #f)) (runname (if testdat (db:get-value-by-header (db:get-rows rundat) (db:get-header rundat) "runname") #f)) - (tdb (tdb:open-test-db-by-test-id-local dbstruct area-dat run-id test-id)) + ;; (tdb (tdb:open-test-db-by-test-id-local dbstruct area-dat run-id test-id)) ;; These next two are intentional bad values to ensure errors if they should not ;; get filled in properly. (logfile "/this/dir/better/not/exist") (rundir (if testdat (db:test-get-rundir testdat) logfile)) - (testdat-path (conc rundir "/testdat.db")) ;; this gets recalculated until found + ;; (testdat-path (conc rundir "/testdat.db")) ;; this gets recalculated until found (teststeps (if testdat (tests:get-compressed-steps dbstruct run-id test-id) '())) (testfullname (if testdat (db:test-get-fullname testdat) "Gathering data ...")) (testname (if testdat (db:test-get-testname testdat) "n/a")) (testmeta (if testdat (let ((tm (db:testmeta-get-record dbstruct testname))) @@ -463,16 +463,16 @@ (system (conc "cd " rundir ";mt_xterm -T \"" (string-translate testfullname "()" " ") "\" " shell "&"))) (message-window (conc "Directory " rundir " not found"))))) (widgets (make-hash-table)) (refreshdat (lambda () - (let* ((curr-mod-time (max (file-modification-time db-path) - (if (file-exists? testdat-path) - (file-modification-time testdat-path) - (begin - (set! testdat-path (conc rundir "/testdat.db")) - 0)))) + (let* ((curr-mod-time (file-modification-time db-path)) + ;; (max ..... (if (file-exists? testdat-path) + ;; (file-modification-time testdat-path) + ;; (begin + ;; (set! testdat-path (conc rundir "/testdat.db")) + ;; 0)))) (need-update (or (and (>= curr-mod-time db-mod-time) (> (current-milliseconds)(+ last-update 250))) ;; every half seconds if db touched (> (current-milliseconds)(+ last-update 10000)) ;; force update even 10 seconds request-update)) (newtestdat (if need-update @@ -695,11 +695,12 @@ (db:test-data-get-tol x) (db:test-data-get-status x) (db:test-data-get-units x) (db:test-data-get-type x) (db:test-data-get-comment x))) - (tdb:open-run-close-db-by-test-id-local dbstruct area-dat run-id test-id #f tdb:read-test-data test-id "%"))) + ;; (tdb:open-run-close-db-by-test-id-local dbstruct area-dat run-id test-id #f tdb:read-test-data test-id "%"))) + (db:read-test-data dbstruct area-dat run-id test-id "%"))) "\n"))) (if (not (equal? currval newval)) (iup:attribute-set! test-data "VALUE" newval ))))) ;; "TITLE" newval))))) test-data)) ;;(dashboard:run-controls) Index: dashboard.scm ================================================================== --- dashboard.scm +++ dashboard.scm @@ -68,10 +68,20 @@ ;; (if (args:get-arg "-host") ;; (begin ;; (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":"))) ;; (client:launch)) ;; (client:launch)) +(define *useserver* (or (args:get-arg "-use-server") + (configf:lookup *configdat* "dashboard" "use-server"))) + +(define *keys* (if *useserver* + (rmt:get-keys) + (db:get-keys *dbstruct-local*))) +(define *tot-run-count* (if *useserver* + (rmt:get-num-runs "%") + (db:get-num-runs *dbstruct-local* "%"))) + ;; ease debugging by loading ~/.dashboardrc (let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) (if (file-exists? debugcontrolf) (load debugcontrolf))) @@ -105,10 +115,30 @@ items) i)) (define (pad-list l n)(append l (make-list (- n (length l))))) + (allruns (if *useserver* + (rmt:get-runs runnamepatt numruns *start-run-offset* keypatts) + (db:get-runs *dbstruct-local* runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2)) + *start-run-offset* keypatts))) + (tests (if *useserver* + (rmt:get-tests-for-run run-id testnamepatt states statuses + #f #f + *hide-not-hide* + sort-by + sort-order + 'shortlist) + (db:get-tests-for-run *dbstruct-local* run-id testnamepatt states statuses + #f #f + *hide-not-hide* + sort-by + sort-order + 'shortlist))) + (key-vals (if *useserver* + (rmt:get-key-vals run-id) + (db:get-key-vals *dbstruct-local* run-id)))) (define (mkstr . x) (string-intersperse (map conc x) ",")) (define (update-search x val) @@ -117,10 +147,13 @@ ;;====================================================================== ;; T E S T S ;;====================================================================== + (db-target-dat (if *useserver* + (rmt:get-targets) + (db:get-targets *dbstruct-local*))) ;; Test browser (define (dashboard:tree-browser data adat window-id) ;; (iup:split (let* ((tb (iup:treebox @@ -217,10 +250,13 @@ ;; General displayer ;; (define (dashboard:area-display data adat window-id) (let* ((view-matrix (iup:matrix ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f)) + (runs-for-targ (if *useserver* + (rmt:get-runs-by-patt *keys* "%" target #f #f #f) + (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f))) #:expand "YES" ;; #:fittosize "YES" #:scrollbar "YES" #:numcol 100 #:numlin 100 @@ -248,10 +284,14 @@ ;; (let* ((runs-dat (db:get-runs-by-patt db *keys* "%" #f #f #f #f)) ;;====================================================================== ;; A R E A S ;;====================================================================== + (if (number? run-id) + (dashboard:update-run-summary-tab)) + (debug:print 0 "ERROR: tree-path->run-id returned non-number " run-id))) + ))) (define (dashboard:init-area data area-name apath) (let* ((mtconffile (conc area-name "/megatest.config")) (mtconf (read-config mtconffile (make-hash-table) #f)) ;; megatest.config (area-dat (let ((ad (make-megatest:area @@ -338,11 +378,14 @@ (nextmintime (current-milliseconds))) (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data))) ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application (iup:show (dashboard:main-panel data (dboard:data-current-window-id data))) ;; Yes, running iup:show will pop up a new panel - ;; (iup:show (main-panel my-window-id)) + (let* ((dat (let ((d (map string->number (string-split (args:get-arg "-test") ",")))) + (if (> (length d) 1) + d + (list #f #f)))) (iup:callback-set! *tim* "ACTION_CB" (lambda (x) (let ((starttime (current-milliseconds))) ;; Want to dedicate no more than 50% of the time to this so skip if Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -1350,12 +1350,16 @@ (db:delay-if-busy dbdat area-dat) (for-each (lambda (toptest) (let ((test-name (list-ref toptest 3))) ;; (run-id (list-ref toptest 5))) - (db:general-call db 'top-test-set-per-pf-counts (list test-name run-id test-name test-name test-name)))) ;; (list run-id test-name)))) + (db:top-test-set-per-pf-counts db run-id test-name))) toplevels))) + +(define (db:top-test-set-per-pf-counts db run-id test-name) + (db:general-call db 'top-test-set-per-pf-counts (list test-name test-name run-id test-name test-name test-name test-name test-name test-name test-name test-name test-name test-name))) + ;; Clean out old junk and vacuum the database ;; ;; Ultimately do something like this: ;; @@ -2724,10 +2728,24 @@ ", expected: " expected " tol: " tol " units: " units " status: " status " comment: " comment) (db:delay-if-busy dbdat area-dat) (sqlite3:execute db "INSERT OR REPLACE INTO test_data (test_id,category,variable,value,expected,tol,units,comment,status,type) VALUES (?,?,?,?,?,?,?,?,?,?);" test-id category variable value expected tol units (if comment comment "") status type))) csvlist))) + +;; This routine moved from tdb.scm, tdb:read-test-data +;; +(define (db:read-test-data dbstruct run-id test-id categorypatt) + (let* ((dbdat (db:get-db dbstruct run-id)) + (db (db:dbdat-get-db dbdat)) + (res '())) + (db:delay-if-busy dbdat) + (sqlite3:for-each-row + (lambda (id test_id category variable value expected tol units comment status type) + (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) + db + "SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt) + (reverse res))) ;;====================================================================== ;; Misc. test related queries ;;====================================================================== @@ -2824,22 +2842,29 @@ (db:general-call dbdat 'set-test-start-time (list test-id))) (if msg (db:general-call dbdat 'state-status-msg (list state status msg test-id)) (db:general-call dbdat 'state-status (list state status test-id))))) -(define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path status) - (if (and (not (equal? item-path "")) - (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED"))) +;; (define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path status) +(define (db:roll-up-pass-fail-counts dbstruct area-dat run-id test-name item-path state status) + (if ;; (and + (not (equal? item-path "")) (let ((dbdat (db:get-db dbstruct area-dat run-id))) + ;; (not (member status '("PASS" "WARN" "FAIL" "WAIVED" "RUNNING" "CHECK" "SKIP" "LAUNCHED"))) (db:general-call dbdat 'update-pass-fail-counts (list test-name test-name test-name)) - (if (equal? status "RUNNING") - (db:general-call dbdat 'top-test-set-running (list test-name)) - (if (equal? status "LAUNCHED") - (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name)) - (db:general-call dbdat 'top-test-set-per-pf-counts (list test-name run-id test-name test-name test-name)))) + ;; NOTE: No else clause needed for this case + (case (string->symbol status) + ((RUNNING) (db:general-call dbdat 'top-test-set-running (list test-name))) + ((LAUNCHED) (db:general-call dbdat 'top-test-set (list "LAUNCHED" test-name))) + ((ABORT INCOMPLETE) (db:general-call dbdat 'top-test-set (list status test-name)))) + (let ((db (db:dbdat-get-db dbdat))) + (db:top-test-set-per-pf-counts db run-id test-name)) #f) - #f)) + ;; if the test is not COMPLETED then this routine should not have been called + (begin + (debug:print 0 "ERROR: db:test-set-state-status called with state " state " and status " status) + #f))) (define (db:test-get-logfile-info dbstruct area-dat run-id test-name) (db:with-db dbstruct area-dat run-id @@ -2898,34 +2923,75 @@ '(update-uname-host "UPDATE tests SET uname=?,host=? WHERE id=?;") ;; DONE '(update-test-state "UPDATE tests SET state=? WHERE state=? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") '(update-test-status "UPDATE tests SET status=? WHERE status like ? AND run_id=? AND testname=? AND NOT (item_path='' AND testname IN (SELECT DISTINCT testname FROM tests WHERE testname=? AND item_path != ''));") ;; stuff for roll-up-pass-fail-counts '(update-pass-fail-counts "UPDATE tests - SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK')), + SET fail_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('FAIL','CHECK','INCOMPLETE','ABORT')), pass_count=(SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status IN ('PASS','WARN','WAIVED')) WHERE testname=? AND item_path='';") ;; DONE '(top-test-set "UPDATE tests SET state=? WHERE testname=? AND item_path='';") ;; DONE '(top-test-set-running "UPDATE tests SET state='RUNNING' WHERE testname=? AND item_path='';") ;; DONE '(top-test-set-per-pf-counts "UPDATE tests SET state=CASE WHEN (SELECT count(id) FROM tests + WHERE testname=? + AND item_path != '' + AND status IN ('INCOMPLETE') + AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'INCOMPLETE' + WHEN (SELECT count(id) FROM tests WHERE testname=? AND item_path != '' AND status NOT IN ('TEN_STRIKES','BLOCKED') AND state in ('RUNNING','NOT_STARTED','LAUNCHED','REMOTEHOSTSTART')) > 0 THEN 'RUNNING' ELSE 'COMPLETED' END, status=CASE WHEN (SELECT count(id) FROM tests WHERE run_id=? AND testname=? AND item_path != '' - AND state IN ('NOT_STARTED','BLOCKED')) > 0 THEN 'FAIL' - WHEN fail_count > 0 THEN 'FAIL' - WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' + AND state IN ('NOT_STARTED','BLOCKED','INCOMPLETE')) > 0 THEN 'FAIL' + WHEN (SELECT count(id) FROM tests + WHERE testname=? + AND item_path != '' + AND state NOT IN ('DELETED') + AND status = 'ABORT') > 0 THEN 'ABORT' + WHEN (SELECT count(id) FROM tests + WHERE testname=? + AND item_path != '' + AND state NOT IN ('DELETED') + AND status = 'AUTO') > 0 THEN 'AUTO' + WHEN (SELECT count(id) FROM tests + WHERE testname=? + AND item_path != '' + AND state NOT IN ('DELETED') + AND status IN ('STUCK/INCOMPLETE', 'INCOMPLETE')) > 0 THEN 'INCOMPLETE' + WHEN (SELECT count(id) FROM tests + WHERE testname=? + AND item_path != '' + AND state NOT IN ('DELETED') + AND status = 'CHECK') > 0 THEN 'CHECK' + WHEN (SELECT count(id) FROM tests + WHERE testname=? + AND item_path != '' + AND state NOT IN ('DELETED') + AND status = 'SKIP') > 0 THEN 'SKIP' + WHEN (SELECT count(id) FROM tests + WHERE testname=? + AND item_path != '' + AND state NOT IN ('DELETED') + AND status = 'WARN') > 0 THEN 'WARN' WHEN (SELECT count(id) FROM tests WHERE testname=? AND item_path != '' - AND status = 'SKIP') > 0 THEN 'SKIP' + AND state NOT IN ('DELETED') + AND status = 'WAIVED') > 0 THEN 'WAIVED' + WHEN (SELECT count(id) FROM tests + WHERE testname=? + AND item_path != '' + AND state NOT IN ('DELETED') + AND status NOT IN ('PASS','FAIL','WARN','WAIVED')) > 0 THEN 'ABORT' + WHEN fail_count > 0 THEN 'FAIL' + WHEN pass_count > 0 AND fail_count=0 THEN 'PASS' ELSE 'UNKNOWN' END WHERE testname=? AND item_path='';") ;; DONE ;; STEPS '(delete-test-step-records "UPDATE test_steps SET status='DELETED' WHERE test_id=?;") @@ -3150,11 +3216,12 @@ ;; Note: mode 'normal means that tests must be COMPLETED and ok (i.e. PASS, WARN, CHECK, SKIP or WAIVED) ;; mode 'toplevel means that tests must be COMPLETED only ;; mode 'itemmatch or 'itemwait means that tests items must be COMPLETED and (PASS|WARN|WAIVED|CHECK) [[ NB// NOT IMPLEMENTED YET ]] ;; ;; (define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path mode) -(define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f)) +;; (define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path #!key (mode '(normal))(itemmap #f)) +(define (db:get-prereqs-not-met dbstruct area-dat run-id waitons ref-item-path mode itemmap) ;; #!key (mode '(normal))(itemmap #f)) (if (or (not waitons) (null? waitons)) '() (let* ((unmet-pre-reqs '()) (result '())) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -322,11 +322,12 @@ ;; force RUNNING/n/a ;; (thread-sleep! 0.3) (tests:test-force-state-status! run-id test-id "RUNNING" "n/a") - (rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING" area-dat) +;; (rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING" area-dat) + (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "RUNNING" area-dat) ;; (thread-sleep! 0.3) ;; NFS slowness has caused grief here ;; if there is a runscript do it first (if fullrunscript (let ((pid (process-run fullrunscript))) @@ -860,11 +861,12 @@ (runs:remove-test-directory testinfo 'remove-data-only))) ;; remove data only, do not perturb the record ;; prevent overlapping actions - set to LAUNCHED as early as possible ;; (tests:test-set-status! run-id test-id "LAUNCHED" "n/a" #f #f) ;; (if launch-results launch-results "FAILED")) - (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED" area-dat) +;; (rmt:roll-up-pass-fail-counts run-id test-name item-path "LAUNCHED" area-dat) + (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "LAUNCHED" area-dat) (set! diskpath (get-best-disk configdat)) (if diskpath (let ((dat (create-work-area run-id run-info keyvals test-id test-path diskpath test-name itemdat))) (set! work-area (car dat)) (set! toptest-work-area (cadr dat)) Index: megatest-version.scm ================================================================== --- megatest-version.scm +++ megatest-version.scm @@ -1,7 +1,7 @@ ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00.. (declare (unit megatest-version)) -(define megatest-version 1.6015) +(define megatest-version 1.6017) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -7,10 +7,14 @@ ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;; (include "common.scm") ;; (include "megatest-version.scm") + +(define (toplevel-command . a) #f) + +(define (toplevel-command . a) #f) ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) (use sqlite3 srfi-1 posix regex regex-case srfi-69 base64 readline apropos json http-client directory-utils rpc ;; (srfi 18) extras) @@ -84,13 +88,11 @@ Usage: megatest [options] -h : this help -version : print megatest version (currently " megatest-version ") Launching and managing runs - -runall : run all tests that are not state COMPLETED and status PASS, - CHECK or KILLED - -runtests tst1,tst2 ... : run tests + -runall : run all tests or as specified by -testpatt -remove-runs : remove the data for a run, requires -runname and -testpatt Optionally use :state and :status -set-state-status X,Y : set state to X and status to Y, requires controls per -remove-runs -rerun FAIL,WARN... : force re-run for tests with specificed status(s) -lock : lock run specified by target and runname @@ -296,11 +298,12 @@ "-get-run-status" ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first - "-runall" ;; run all tests + "-runall" ;; run all tests, respects -testpatt + "-run" ;; alias for -runall "-remove-runs" "-rebuild-db" "-cleanup-db" "-rollup" "-update-meta" @@ -887,11 +890,11 @@ "-set-run-status" "set run status" (lambda (target runname keys keyvals) (let* ((runsdat (rmt:get-runs-by-patt keys runname (common:args-get-target) - #f #f)) + #f #f #f)) (header (vector-ref runsdat 0)) (rows (vector-ref runsdat 1))) (if (null? rows) (begin (debug:print-info 0 "No matching run found.") @@ -942,11 +945,11 @@ (testpatt (if (args:get-arg "-testpatt") (args:get-arg "-testpatt") "%")) (keys (db:get-keys dbstruct)) ;; (runsda t (db:get-runs dbstruct runpatt #f #f '())) - (runsdat (rmt:get-runs-by-patt keys (or runpatt "%") (common:args-get-target) + (runsdat (db:get-runs-by-patt dbstruct keys (or runpatt "%") (common:args-get-target) #f #f '("id" "runname" "state" "status" "owner" "event_time" "comment"))) (runstmp (db:get-rows runsdat)) (header (db:get-header runsdat)) (runs (if (and (not (null? runstmp)) (args:get-arg "-since")) @@ -966,15 +969,15 @@ (dmode (let ((d (args:get-arg "-dumpmode"))) (if d (string->symbol d) #f))) (data (make-hash-table)) (fields-spec (if (args:get-arg "-fields") (extract-fields-constraints (args:get-arg "-fields")) - (list (list "runs" "id" "target" "runname") + (list (cons "runs" (append keys (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count"))) (cons "tests" db:test-record-fields) ;; "id" "testname" "test_path") (list "steps" "id" "stepname")))) - (runs-spec (let ((r (alist-ref "runs" fields-spec equal?))) - (if (and r (not (null? r))) r (list "id")))) + (runs-spec (let ((r (alist-ref "runs" fields-spec equal?))) ;; the check is now unnecessary + (if (and r (not (null? r))) r (list "id" )))) (tests-spec (let ((t (alist-ref "tests" fields-spec equal?))) (if (and t (null? t)) ;; all fields db:test-record-fields t))) (adj-tests-spec (delete-duplicates (if tests-spec (cons "id" tests-spec) db:test-record-fields))) ;; '("id")))) @@ -1002,15 +1005,18 @@ (if db-targets (if (not (hash-table-ref/default seen targetstr #f)) (begin (hash-table-set! seen targetstr #t) ;; (print "[" targetstr "]")))) - (if (not dmode)(print targetstr)))) + (if (not dmode) + (print targetstr) + (hash-table-set! data "targets" (cons targetstr (hash-table-ref/default data "targets" '()))) + ))) (let* ((run-id (db:get-value-by-header run header "id")) (runname (db:get-value-by-header run header "runname")) (tests (if tests-spec - (rmt:get-tests-for-run run-id testpatt '() '() #f #f #f 'testname 'asc + (db:get-tests-for-run dbstruct run-id testpatt '() '() #f #f #f 'testname 'asc ;; use qryvals if test-spec provided (if tests-spec (string-intersperse adj-tests-spec ",") ;; db:test-record-fields #f)) @@ -1141,11 +1147,11 @@ ;; put task in deferred queue ;; if still ok to run tasks ;; process deferred tasks per above steps ;; run all tests are are Not COMPLETED and PASS or CHECK -(if (args:get-arg "-runall") +(if (or (args:get-arg "-runall")(args:get-arg "-run")) (general-run-call "-runall" "run all tests" (lambda (target runname keys keyvals) (runs:run-tests target ADDED multi-dboard.scm Index: multi-dboard.scm ================================================================== --- /dev/null +++ multi-dboard.scm @@ -0,0 +1,374 @@ +;;====================================================================== +;; Copyright 2006-2013, Matthew Welland. +;; +;; This program is made available under the GNU GPL version 2.0 or +;; greater. See the accompanying file COPYING for details. +;; +;; This program is distributed WITHOUT ANY WARRANTY; without even the +;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR +;; PURPOSE. +;;====================================================================== + +(use format numbers) +(require-library iup) +(import (prefix iup iup:)) +(use canvas-draw) + +(use sqlite3 srfi-1 posix regex regex-case srfi-69) +(import (prefix sqlite3 sqlite3:)) + +(declare (uses margs)) +(declare (uses launch)) +(declare (uses megatest-version)) +(declare (uses gutils)) +(declare (uses db)) +(declare (uses server)) +(declare (uses synchash)) +(declare (uses dcommon)) +(declare (uses tree)) +(declare (uses configf)) + +(include "common_records.scm") +(include "db_records.scm") +(include "key_records.scm") + +(define help (conc + "Megatest Dashboard, documentation at http://www.kiatoa.com/fossils/megatest + version " megatest-version " + license GPL, Copyright (C) Matt Welland 2011 + +Usage: dashboard [options] + -h : this help + -group groupname : display this group of areas + -test testid : control test identified by testid + -guimonitor : control panel for runs + +Misc + -rows N : set number of rows +")) + +;; process args +(define remargs (args:get-args + (argv) + (list "-group" ;; display this group of areas + "-debug" + ) + (list "-h" + "-v" + "-q" + ) + args:arg-hash + 0)) + +(if (args:get-arg "-h") + (begin + (print help) + (exit))) + +;; (if (args:get-arg "-host") +;; (begin +;; (set! (common:get-remote remote) (string-split (args:get-arg "-host" ":"))) +;; (client:launch)) +;; (client:launch)) + +;; ease debugging by loading ~/.dashboardrc +(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.dashboardrc"))) + (if (file-exists? debugcontrolf) + (load debugcontrolf))) + +(define *runremote* #f) + +(debug:setup) + +(define *tim* (iup:timer)) +(define *ord* #f) + +(iup:attribute-set! *tim* "TIME" 300) +(iup:attribute-set! *tim* "RUN" "YES") + +(define (message-window msg) + (iup:show + (iup:dialog + (iup:vbox + (iup:label msg #:margin "40x40"))))) + +(define (iuplistbox-fill-list lb items . default) + (let ((i 1) + (selected-item (if (null? default) #f (car default)))) + (iup:attribute-set! lb "VALUE" (if selected-item selected-item "")) + (for-each (lambda (item) + (iup:attribute-set! lb (number->string i) item) + (if selected-item + (if (equal? selected-item item) + (iup:attribute-set! lb "VALUE" item))) ;; (number->string i)))) + (set! i (+ i 1))) + items) + i)) + +(define (pad-list l n)(append l (make-list (- n (length l))))) + + +(define (mkstr . x) + (string-intersperse (map conc x) ",")) + +(define (update-search x val) + (hash-table-set! *searchpatts* x val)) + + +;;====================================================================== +;; T E S T S +;;====================================================================== + + +;; Test browser +(define (dashboard:tree-browser data adat window-id) + ;; (iup:split + (let* ((tb (iup:treebox + #:selection-cb + (lambda (obj id state) + ;; (print "obj: " obj ", id: " id ", state: " state) + (let* ((tree-path (tree:node->path obj id)) + (area (car tree-path)) + (area-path (cdr tree-path))) + #f + ;; (test-id (tree-path->test-id (cdr run-path)))) + ;; (if test-id + ;; (hash-table-set! (dboard:data-get-curr-test-ids *data*) + ;; window-id test-id)) + ;; (print "path: " (tree:node->path obj id) " test-id: " test-id)))))) + ))))) + ;; (iup:attribute-set! tb "VALUE" "0") + ;; (iup:attribute-set! tb "NAME" "Runs") + ;; (iup:attribute-set! tb "ADDEXPANDED" "NO") + ;; (dboard:data-set-tests-tree! *data* tb) + tb)) +;; (test-panel window-id))) + +;; The function to update the fields in the test view panel +(define (test-update window-id testdat run-info-matrix test-info-matrix test-run-matrix meta-dat-matrix steps-matrix data-matrix) + ;; get test-id + ;; then get test record + (if testdat + (let* ((test-id (hash-table-ref/default (dboard:data-get-curr-test-ids *data*) window-id #f)) + (test-data (hash-table-ref/default testdat test-id #f)) + (run-id (db:test-get-run_id test-data)) + (targ/runname (hash-table-ref/default (dboard:data-get-run-keys *data*) + run-id + '())) + (target (if (null? targ/runname) "" (string-intersperse (reverse (cdr (reverse targ/runname))) "/"))) + (runname (if (null? targ/runname) "" (car (cdr targ/runname)))) + (steps-dat (tests:get-compressed-steps *dbstruct-local* run-id test-id))) + + (if test-data + (begin + ;; + (for-each + (lambda (data) + (let ((mat (car data)) + (vals (cadr data)) + (rownum 1)) + (for-each + (lambda (key) + (let ((cell (conc rownum ":1"))) + (if (not (equal? (iup:attribute mat cell)(conc key))) + (begin + ;; (print "setting cell " cell " in matrix " mat " to value " key) + (iup:attribute-set! mat cell (conc key)) + (iup:attribute-set! mat "REDRAW" cell))) + (set! rownum (+ rownum 1)))) + vals))) + (list + (list run-info-matrix + (if test-id + (list (db:test-get-run_id test-data) + target + runname + "n/a") + (make-list 4 ""))) + (list test-info-matrix + (if test-id + (list test-id + (db:test-get-testname test-data) + (db:test-get-item-path test-data) + (db:test-get-state test-data) + (db:test-get-status test-data) + (seconds->string (db:test-get-event_time test-data)) + (db:test-get-comment test-data)) + (make-list 7 ""))) + (list test-run-matrix + (if test-id + (list (db:test-get-host test-data) + (db:test-get-uname test-data) + (db:test-get-diskfree test-data) + (db:test-get-cpuload test-data) + (seconds->hr-min-sec (db:test-get-run_duration test-data))) + (make-list 5 ""))) + )) + (dcommon:populate-steps steps-dat steps-matrix)))))) +;;(list meta-dat-matrix +;; (if test-id +;; (list ( + + +;;====================================================================== +;; R U N C O N T R O L +;;====================================================================== + +;; General displayer +;; +(define (dashboard:area-display data adat window-id) + (let* ((view-matrix (iup:matrix + ;; (runs-for-targ (db:get-runs-by-patt *dbstruct-local* *keys* "%" target #f #f #f)) + #:expand "YES" + ;; #:fittosize "YES" + #:scrollbar "YES" + #:numcol 100 + #:numlin 100 + #:numcol-visible 3 + #:numlin-visible 3 + #:click-cb (lambda (obj lin col status) + (print "obj: " obj " lin: " lin " col: " col " status: " status))))) + + (iup:attribute-set! view-matrix "RESIZEMATRIX" "YES") + (iup:attribute-set! view-matrix "WIDTH0" "100") + ;; (dboard:data-set-runs-matrix! *data* runs-matrix) + (iup:hbox + (iup:frame + #:title "Runs browser" + (iup:vbox + view-matrix))))) + +;; Browse and control a single run +;; +(define (runcontrol window-id) + (iup:hbox)) + +;; NB// Wierd conflict error here +;; +;; (let* ((runs-dat (db:get-runs-by-patt db *keys* "%" #f #f #f #f)) + +;;====================================================================== +;; A R E A S +;;====================================================================== + +(define (dashboard:init-area data area-name apath) + (let* ((mtconffile (conc area-name "/megatest.config")) + (mtconf (read-config mtconffile (make-hash-table) #f)) ;; megatest.config + (area-dat (let ((ad (make-megatest:area + area-name ;; area name + apath ;; path to area + 'http ;; transport + (list apath mtconf) ;; configinfo (legacy) + mtconf ;; megatest.config + (make-hash-table) ;; denoise hash + #f ;; client-signature + #f ;; remote connections + #f ;; run keys + (make-hash-table) ;; run-id -> (hash of test-ids => dat) + (and (file-exists? apath)(file-write-access? apath)) ;; read-only + ))) + (hash-table-set! (dboard:data-areas data) area-name ad) + ad))) + area-dat)) + +;;====================================================================== +;; D A S H B O A R D +;;====================================================================== + +;; Main Panel +;; +(define (dashboard:main-panel data window-id) + (iup:dialog + #:title "Megatest Control Panel" + #:menu (dcommon:main-menu data) + #:shrink "YES" + (iup:vbox + (let* ((area-names (hash-table-keys (dboard:data-cfgdat data))) + (area-panels (map (lambda (aname) + (let* ((apath (configf:lookup (dboard:data-cfgdat data) aname "path")) ;; (hash-table-ref (dboard:data-cfgdat data) area-name)) + ;; (hash-table-ref (dboard:data-cfgdat data) aname)) + (area-dat (dashboard:init-area data aname apath)) + (tb (dashboard:tree-browser data area-dat window-id)) ;; (dboard:areas-tree-browser data) + (ad (dashboard:area-display data area-dat window-id)) + (areas (dboard:data-areas data)) + (dboard-dat (make-dboard:tab + #f ;; tree + #f ;; matrix + area-dat ;; + #f ;; view path + 'default ;; view type + #f ;; controls + #f ;; cached data + #f ;; filters + #f ;; the run-id + (make-hash-table) ;; run-id -> test-id, for current test id + "" + ))) + (hash-table-set! (dboard:data-areas data) aname dboard-dat) + (dboard:tab-tree-set! dboard-dat tb) + (dboard:tab-matrix-set! dboard-dat ad) + (iup:split + #:value 200 + tb ad))) + area-names)) + (tabtop (apply iup:tabs + #:tabchangepos-cb (lambda (obj curr prev) + (dboard:data-current-tab-id-set! data curr) + (dboard:data-update-needed-set! data #t) + (print "Tab is: " curr ", prev was " prev)) + area-panels)) + (tab-ids (dboard:data-tab-ids data))) + (let loop ((index 0) + (hed (car area-names)) + (tal (cdr area-names))) + (hash-table-set! tab-ids index hed) + (debug:print 0 "Adding area " hed " with index " index " to dashboard") + (iup:attribute-set! tabtop (conc "TABTITLE" index) hed) + (if (not (null? tal)) + (loop (+ index 1)(car tal)(cdr tal)))) + tabtop)))) + +(define (newdashboard data window-id) + (let* (;; (keys (db:get-keys *dbstruct-local* *area-dat*)) + ;; (runname "%") + ;; (testpatt "%") + ;; (keypatts (map (lambda (k)(list k "%")) keys)) + ;; (states '()) + ;; (statuses '()) + (nextmintime (current-milliseconds))) + (dboard:data-current-window-id-set! data (+ 1 (dboard:data-current-window-id data))) + ;; (dboard:data-set-runs! *data* data) ;; make this data available to the rest of the application + (iup:show (dashboard:main-panel data (dboard:data-current-window-id data))) + ;; Yes, running iup:show will pop up a new panel + ;; (iup:show (main-panel my-window-id)) + (iup:callback-set! *tim* + "ACTION_CB" + (lambda (x) + (let ((starttime (current-milliseconds))) + ;; Want to dedicate no more than 50% of the time to this so skip if + ;; 2x delta time has not passed since last query + ;; (if (< (inexact->exact nextmintime)(inexact->exact starttime)) + ;; (let* ((changes (dcommon:run-update data)) ;;keys data runname keypatts testpatt states statuses 'full my-window-id)) + ;; (endtime (current-milliseconds))) + ;; (set! nextmintime (+ endtime (* 2.0 (- endtime starttime)))) + ;; ;; (debug:print 11 "CHANGE(S): " (car changes) "...") + ;; ) + ;; (debug:print-info 11 "Server overloaded"))))))) + (dcommon:run-update data)))))) + +;;; main. Theoretically could have multiple windows (each with a group of tags, thus window-id +;;; +(let* ((window-id 0) + (groupn (or (args:get-arg "-group") "default")) + (cfname (conc (getenv "HOME") "/.megatest/" groupn ".dat")) + (cfgdat (if (file-exists? cfname)(read-config cfname (make-hash-table) #t))) + (data (make-dboard:data + cfgdat ;; this is the data from ~/.megatest for the selected group + (make-hash-table) ;; areaname -> area-rec + 0 ;; current window id + 0 ;; current tab id + #f ;; redraw needed for current tab id + (make-hash-table) ;; tab-id -> areaname + ))) + (newdashboard data window-id) + (iup:main-loop)) Index: rmt.scm ================================================================== --- rmt.scm +++ rmt.scm @@ -163,13 +163,24 @@ (if (and faststart (equal? faststart "no")) (begin (tasks:start-and-wait-for-server (db:delay-if-busy (tasks:open-db area-dat)) run-id 10) (thread-sleep! (random 5)) ;; give some time to settle and minimize collison? (rmt:send-receive cmd rid params area-dat attemptnum: (+ attemptnum 1))) - (begin - (server:kind-run run-id area-dat) - (rmt:open-qry-close-locally cmd run-id area-dat params)))) + (let ((start-time (current-milliseconds)) + (max-query (string->number (or (configf:lookup *configdat* "server" "server-query-threshold") + "300"))) + (newres (rmt:open-qry-close-locally cmd run-id params))) + (let ((delta (- (current-milliseconds) start-time))) + (if (> delta max-query) + (begin + ;; (server:kind-run run-id area-dat) + ;; (rmt:open-qry-close-locally cmd run-id area-dat params)))) + (debug:print-info 0 "Starting server as query time " delta " is over the limit of " max-query) + (server:kind-run run-id))) + ;; return the result! + newres) + ))) (begin ;; (debug:print 0 "ERROR: Communication failed!") ;; (mutex-unlock! *send-receive-mutex*) ;; (exit) (rmt:open-qry-close-locally cmd run-id area-dat params) @@ -354,14 +365,24 @@ (rmt:send-receive 'get-key-val-pairs run-id (list run-id) area-dat)) (define (rmt:get-keys area-dat) (rmt:send-receive 'get-keys #f '() area-dat)) +(define (rmt:get-key-vals run-id) + (rmt:send-receive 'get-key-vals #f (list run-id))) + +(define (rmt:get-targets) + (rmt:send-receive 'get-targets #f '())) + ;;====================================================================== ;; T E S T S ;;====================================================================== +;; Just some syntatic sugar NOTE: Need to add area-dat +(define (rmt:register-test run-id test-name item-path) + (rmt:general-call 'register-test run-id run-id test-name item-path)) + (define (rmt:get-test-id run-id testname item-path area-dat) (rmt:send-receive 'get-test-id run-id (list run-id testname item-path) area-dat)) (define (rmt:get-test-info-by-id run-id test-id area-dat) (if (and (number? run-id)(number? test-id)) @@ -494,12 +515,12 @@ run-ids)))) (define (rmt:get-run-ids-matching keynames target res area-dat) (rmt:send-receive #f 'get-run-ids-matching (list keynames target res) area-dat) area-dat) -(define (rmt:get-prereqs-not-met run-id waitons ref-item-path area-dat #!key (mode '(normal))) - (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode) area-dat)) +(define (rmt:get-prereqs-not-met run-id waitons ref-item-path area-dat #!key (mode '(normal))(itemmap #f)) + (rmt:send-receive 'get-prereqs-not-met run-id (list run-id waitons ref-item-path mode itemmap) area-dat)) (define (rmt:get-count-tests-running-for-run-id run-id area-dat) (rmt:send-receive 'get-count-tests-running-for-run-id run-id (list run-id) area-dat)) ;; Statistical queries @@ -511,12 +532,14 @@ (rmt:send-receive 'get-count-tests-running-for-testname run-id (list run-id testname) area-dat)) (define (rmt:get-count-tests-running-in-jobgroup run-id jobgroup area-dat) (rmt:send-receive 'get-count-tests-running-in-jobgroup run-id (list run-id jobgroup) area-dat)) -(define (rmt:roll-up-pass-fail-counts run-id test-name item-path status area-dat) - (rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path status) area-dat)) +;; state and status are extra hints not usually used in the calculation +;; +(define (rmt:roll-up-pass-fail-counts run-id test-name item-path state status area-dat) + (rmt:send-receive 'roll-up-pass-fail-counts run-id (list run-id test-name item-path state status) area-dat)) (define (rmt:update-pass-fail-counts run-id test-name area-dat) (rmt:general-call 'update-fail-pass-counts run-id (list run-id test-name run-id test-name run-id test-name) area-dat)) ;;====================================================================== @@ -524,10 +547,13 @@ ;;====================================================================== (define (rmt:get-run-info run-id area-dat) (rmt:send-receive 'get-run-info run-id (list run-id) area-dat)) +(define (rmt:get-num-runs runpatt) + (rmt:send-receive 'get-num-runs #f (list runpatt))) + ;; Use the special run-id == #f scenario here since there is no run yet (define (rmt:register-run keyvals runname state status user area-dat) (rmt:send-receive 'register-run #f (list keyvals runname state status user) area-dat)) (define (rmt:get-run-name-from-id run-id area-dat) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -264,12 +264,12 @@ (set! all-test-names (hash-table-keys all-tests-registry)) (set! test-names (tests:filter-test-names all-test-names test-patts)) ;; I think seeding required-tests with all test-names makes sense but lack analysis to back that up. ;; - ;; (set! required-tests (lset-intersection equal? (string-split test-patts ",") all-test-names)) - (set! required-tests (lset-intersection equal? test-names all-test-names)) + (set! required-tests (lset-intersection equal? (string-split test-patts ",") all-test-names)) + ;; (set! required-tests (lset-intersection equal? test-names all-test-names)) ;; look up all tests matching the comma separated list of globs in ;; test-patts (using % as wildcard) ;; (set! test-names (delete-duplicates (tests:get-valid-tests toppath test-patts))) @@ -291,11 +291,11 @@ ;; on test A but test B reached the point on being registered as NOT_STARTED and test ;; A failed for some reason then on re-run using -keepgoing the run can never complete. ;; ;; (rmt:general-call 'delete-tests-in-state run-id "NOT_STARTED") - ;; Now convert FAIL and anything in allow-auto-rerun to NOT_STARTED + ;; Now convert anything in allow-auto-rerun to NOT_STARTED ;; (for-each (lambda (state) (rmt:set-tests-state-status run-id test-names state #f "NOT_STARTED" state area-dat)) (string-split (or (configf:lookup configdat "setup" "allow-auto-rerun") ""))))) @@ -483,11 +483,11 @@ (define runs:nothing-left-in-queue-count 0) (define (runs:expand-items hed tal reg reruns regfull newtal jobgroup max-concurrent-jobs run-id waitons item-path testmode test-record can-run-more items runname tconfig reglen test-registry test-records itemmap area-dat) (let* ((loop-list (list hed tal reg reruns)) - (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path area-dat itemmap: itemmap)) + (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path area-dat mode: testmode itemmap: itemmap)) ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap)) (fails (runs:calc-fails prereqs-not-met)) (prereq-fails (runs:calc-prereq-fail prereqs-not-met)) (non-completed (runs:calc-not-completed prereqs-not-met)) (runnables (runs:calc-runnable prereqs-not-met))) @@ -673,11 +673,11 @@ (have-resources (car run-limits-info)) (num-running (list-ref run-limits-info 1)) (num-running-in-jobgroup (list-ref run-limits-info 2)) (max-concurrent-jobs (list-ref run-limits-info 3)) (job-group-limit (list-ref run-limits-info 4)) - (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path testmode area-dat itemmap: itemmap)) + (prereqs-not-met (rmt:get-prereqs-not-met run-id waitons item-path area-dat mode: testmode itemmap: itemmap)) ;; (prereqs-not-met (mt:lazy-get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap)) (fails (runs:calc-fails prereqs-not-met)) (non-completed (filter (lambda (x) ;; remove hed from not completed list, duh, of course it is not completed! (not (equal? x hed))) (runs:calc-not-completed prereqs-not-met))) @@ -725,21 +725,21 @@ ;; ((not (hash-table-ref/default test-registry (db:test-make-full-name test-name item-path) #f)) (debug:print-info 4 "Pre-registering test " test-name "/" item-path " to create placeholder" ) ;; always do firm registration now in v1.60 and greater ;; (eq? *transport-type* 'fs) ;; no point in parallel registration if use fs (let register-loop ((numtries 15)) - (rmt:general-call 'register-test run-id area-dat run-id test-name item-path) + (rmt:register-test area-dat run-id test-name item-path) (if (rmt:get-test-id run-id test-name item-path) (hash-table-set! test-registry (db:test-make-full-name test-name item-path) 'done) (if (> numtries 0) (begin (thread-sleep! 0.5) (register-loop (- numtries 1))) (debug:print 0 "ERROR: failed to register test " (db:test-make-full-name test-name item-path))))) (if (not (eq? (hash-table-ref/default test-registry (db:test-make-full-name test-name "") #f) 'done)) (begin - (rmt:general-call 'register-test run-id area-dat run-id test-name "") + (rmt:register-test area-dat run-id test-name "") (if (rmt:get-test-id run-id test-name "") (hash-table-set! test-registry (db:test-make-full-name test-name "") 'done)))) (runs:shrink-can-run-more-tests-count) ;; DELAY TWEAKER (still needed?) (if (and (null? tal)(null? reg)) (list hed tal (append reg (list hed)) reruns) @@ -885,11 +885,11 @@ (debug:print 0 "WARNING: test " hed " has FAILED prerequitests and we've tried at least 10 times to run it. Giving up now.")) ;; (debug:print 0 " prereqs: " prereqs-not-met) (hash-table-set! test-registry hed 'removed) (mt:test-set-state-status-by-testname run-id test-name item-path "NOT_STARTED" "TEN_STRIKES" #f) ;; I'm unclear on if this roll up is needed - it may be the root cause of the "all set to FAIL" bug. - (rmt:roll-up-pass-fail-counts run-id test-name item-path "FAIL") ;; treat as FAIL + (rmt:roll-up-pass-fail-counts run-id test-name item-path #f "FAIL") ;; treat as FAIL (list (if (null? tal)(car newtal)(car tal)) tal reg reruns))))) ;; can't drop this - maybe running? Just keep trying @@ -907,11 +907,11 @@ (if (not (vector? t)) t (let ((state (db:test-get-state t)) (status (db:test-get-status t))) (case (string->symbol state) - ((COMPLETED) #f) + ((COMPLETED INCOMPLETE) #f) ((NOT_STARTED) (if (member status '("TEN_STRIKES" "BLOCKED" "PREQ_FAIL" "ZERO_ITEMS" "PREQ_DISCARDED" "TIMED_OUT" )) #f t)) ((DELETED) #f) @@ -1011,11 +1011,11 @@ ;; Ensure all top level tests get registered. This way they show up as "NOT_STARTED" on the dashboard ;; and it is clear they *should* have run but did not. (if (not (hash-table-ref/default test-registry (db:test-make-full-name test-name "") #f)) (begin - (rmt:general-call 'register-test run-id area-dat run-id test-name "" area-dat) + (rmt:register-test area-dat run-id test-name "") (hash-table-set! test-registry (db:test-make-full-name test-name "") 'done))) ;; Fast skip of tests that are already "COMPLETED" - NO! Cannot do that as the items may not have been expanded yet :( ;; (if (member (hash-table-ref/default test-registry tfullname #f) @@ -1188,11 +1188,11 @@ (debug:print-info 1 "All tests launched"))) (define (runs:calc-fails prereqs-not-met) (filter (lambda (test) (and (vector? test) ;; not (string? test)) - (equal? (db:test-get-state test) "COMPLETED") + (member (db:test-get-state test) '("INCOMPLETE" "COMPLETED")) (not (member (db:test-get-status test) '("PASS" "WARN" "CHECK" "WAIVED" "SKIP"))))) prereqs-not-met)) (define (runs:calc-prereq-fail prereqs-not-met) @@ -1205,19 +1205,19 @@ (define (runs:calc-not-completed prereqs-not-met) (filter (lambda (t) (or (not (vector? t)) - (not (equal? "COMPLETED" (db:test-get-state t))))) + (not (member (db:test-get-state t) '("INCOMPLETE" "COMPLETED"))))) prereqs-not-met)) -(define (runs:calc-not-completed prereqs-not-met) - (filter - (lambda (t) - (or (not (vector? t)) - (not (equal? "COMPLETED" (db:test-get-state t))))) - prereqs-not-met)) +;; (define (runs:calc-not-completed prereqs-not-met) +;; (filter +;; (lambda (t) +;; (or (not (vector? t)) +;; (not (equal? "COMPLETED" (db:test-get-state t))))) +;; prereqs-not-met)) (define (runs:calc-runnable prereqs-not-met) (filter (lambda (t) (or (not (vector? t)) @@ -1294,11 +1294,11 @@ ;; (if (not test-id)(set! test-id (rmt:get-test-id run-id test-name item-path area-dat))) (if (not test-id) (begin (debug:print 2 "WARN: Test not pre-created? test-name=" test-name ", item-path=" item-path ", run-id=" run-id) - (rmt:general-call 'register-test run-id area-dat run-id test-name item-path area-dat) + (rmt:register-test area-dat run-id test-name item-path) (set! test-id (rmt:get-test-id run-id test-name item-path area-dat)))) (debug:print-info 4 "test-id=" test-id ", run-id=" run-id ", test-name=" test-name ", item-path=\"" item-path "\"") (set! testdat (rmt:get-test-info-by-id run-id test-id area-dat)) (if (not testdat) (begin @@ -1318,17 +1318,17 @@ (if testdat (string->symbol (test:get-state testdat)) 'failed-to-insert)) ((failed-to-insert) (debug:print 0 "ERROR: Failed to insert the record into the db")) - ((NOT_STARTED COMPLETED DELETED) + ((NOT_STARTED COMPLETED DELETED INCOMPLETE) (let ((runflag #f)) (cond ;; -force, run no matter what (force (set! runflag #t)) ;; NOT_STARTED, run no matter what - ((member (test:get-state testdat) '("DELETED" "NOT_STARTED"))(set! runflag #t)) + ((member (test:get-state testdat) '("DELETED" "NOT_STARTED" "INCOMPLETE"))(set! runflag #t)) ;; not -rerun and PASS, WARN or CHECK, do no run ((and (or (not rerun) keepgoing) ;; Require to force re-run for COMPLETED or *anything* + PASS,WARN or CHECK (or (member (test:get-status testdat) '("PASS" "WARN" "CHECK" "SKIP" "WAIVED")) @@ -1382,11 +1382,11 @@ ((and skip-check (configf:lookup test-conf "skip" "rundelay")) ;; run-ids = #f means *all* runs (let* ((numseconds (common:hms-string->seconds (configf:lookup test-conf "skip" "rundelay"))) (running-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("RUNNING" "REMOTEHOSTSTART" "LAUNCHED") '() #f)) - (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED") '("PASS" "FAIL" "ABORT") #f)) + (completed-tests (rmt:get-tests-for-runs-mindata #f full-test-name '("COMPLETED" "INCOMPLETE") '("PASS" "FAIL" "ABORT") #f)) ;; ironically INCOMPLETE is same as COMPLETED in this contex (last-run-times (map db:mintest-get-event_time completed-tests)) (time-since-last (- (current-seconds) (if (null? last-run-times) 0 (apply max last-run-times))))) (if (or (not (null? running-tests)) ;; have to skip if test is running (> numseconds time-since-last)) (set! skip-test (conc "Skipping due to previous test run less than " (configf:lookup test-conf "skip" "rundelay") " ago")))))) Index: tdb.scm ================================================================== --- tdb.scm +++ tdb.scm @@ -40,11 +40,14 @@ ;;====================================================================== ;; T E S T S P E C I F I C D B ;;====================================================================== ;; Create the sqlite db for the individual test(s) -(define (open-test-db work-area area-dat) +;; +;; Moved these tables into .db +;; THIS CODE TO BE REMOVED +;; (debug:print-info 11 "open-test-db " work-area) (if (and work-area (directory? work-area) (file-read-access? work-area)) (let* ((dbpath (conc work-area "/testdat.db")) @@ -169,10 +172,12 @@ val TEXT, ackstate INTEGER DEFAULT 0, CONSTRAINT metadat_constraint UNIQUE (var));")))) (debug:print 11 "db:testdb-initialize END")) +;; This routine moved to db:read-test-data +;; (define (tdb:read-test-data tdb test-id categorypatt) (let ((res '())) (sqlite3:for-each-row (lambda (id test_id category variable value expected tol units comment status type) (set! res (cons (vector id test_id category variable value expected tol units comment status type) res))) @@ -221,10 +226,12 @@ (define (tdb:step-get-time-as-string vec) (seconds->time-string (tdb:step-get-event_time vec))) ;; get a pretty table to summarize steps +;; +;; NOT USED, WILL BE REMOVED ;; (define (tdb:get-steps-table steps);; organise the steps for better readability (let ((res (make-hash-table))) (for-each (lambda (step) Index: testnanomsg/req-rep-client.scm ================================================================== --- testnanomsg/req-rep-client.scm +++ testnanomsg/req-rep-client.scm @@ -9,11 +9,11 @@ (define (client-send-receive soc msg) (nn-send soc msg) (nn-recv soc)) (define ((talk-to-server soc)) - (let loop ((cnt 20)) + (let loop ((cnt 2000)) (let ((name (list-ref '("Matt" "Tom" "Bob" "Jill" "James" "Jane")(random 6)))) (print "Sending " name) (print (client-send-receive req name)) (if (> cnt 0)(loop (- cnt 1))))) (print (client-send-receive req "quit")) Index: testnanomsg/req-rep-server.scm ================================================================== --- testnanomsg/req-rep-server.scm +++ testnanomsg/req-rep-server.scm @@ -22,12 +22,12 @@ (equal? (substring msg-in 0 4) "ping")) (nn-send soc (conc (current-process-id))) (loop (nn-recv soc))) ;;((and (>= (string-length msg-in) (else - (let ((this-task (random 15))) - (thread-sleep! this-task) + (let ((this-task (random 10))) + (thread-sleep! (/ this-task 10.0)) (nn-send soc (conc "hello " msg-in " this task took " this-task " seconds to complete")) (loop (nn-recv soc))))))) (define (ping-self host port #!key (return-socket #t)) ;; send a random number along with pid and check that we get it back Index: testnanomsg/req-rep.scm ================================================================== --- testnanomsg/req-rep.scm +++ testnanomsg/req-rep.scm Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -32,17 +32,25 @@ (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") ;; Call this one to do all the work and get a standardized list of tests -(define (tests:get-all area-dat) - (let* ((test-search-path (tests:get-tests-search-path (megatest:area-configdat area-dat) area-dat))) +;; gets paths from configs and finds valid tests +;; returns hash of testname --> fullpath +;; (tests:get-valid-tests (make-hash-table) test-search-path))) (define (tests:get-tests-search-path cfgdat area-dat) (let ((paths (map cadr (configf:get-section cfgdat "tests-paths")))) - (append paths (list (conc (megatest:area-path area-dat) "/tests"))))) + (filter (lambda (d) +;; (append paths (list (conc (megatest:area-path area-dat) "/tests"))))) + (if (directory-exists? d) + d + (begin + (debug:print 0 "WARNING: problem with directory " d ", dropping it from tests path") + #f))) + (append paths (list (conc *toppath* "/tests")))))) (define (tests:get-valid-tests test-registry tests-paths) (if (null? tests-paths) test-registry (let loop ((hed (car tests-paths)) @@ -284,11 +292,11 @@ (rmt:csv->test-data run-id test-id dat)))) ;; need to update the top test record if PASS or FAIL and this is a subtest (if (not (equal? item-path "")) - (rmt:roll-up-pass-fail-counts run-id test-name item-path status)) + (rmt:roll-up-pass-fail-counts run-id test-name item-path state status)) (if (or (and (string? comment) (string-match (regexp "\\S+") comment)) waived) (let ((cmt (if waived waived comment))) @@ -583,10 +591,11 @@ ;; (filter (lambda (testname) ;; (tests:match test-patts testname #f)) ;; (map (lambda (testp) ;; (last (string-split testp "/"))) ;; tests))))) + (define (tests:get-testconfig test-name test-registry system-allowed area-dat) (let* ((test-path (hash-table-ref/default test-registry test-name (conc (megatest:area-path area-dat) "/tests/" test-name))) (test-configf (conc test-path "/testconfig")) (testexists (and (file-exists? test-configf)(file-read-access? test-configf))) @@ -670,11 +679,11 @@ (for-each (lambda (waiton) ;; for now we are waiting only on the parent test (let* ((parent-test-id (rmt:get-test-id run-id waiton "")) (wtdat (rmt:get-testinfo-state-status run-id test-id))) ;; (cdb:get-test-info-by-id (common:get-remote remote) test-id))) (if (or (and (equal? (db:test-get-state wtdat) "COMPLETED") - (member (db:test-get-status wtdat) '("FAIL"))) + (member (db:test-get-status wtdat) '("FAIL" "ABORT"))) (member (db:test-get-status wtdat) '("KILLED")) (member (db:test-get-state wtdat) '("INCOMPETE"))) ;; (if (or (member (db:test-get-status wtdat) ;; '("FAIL" "KILLED")) ;; (member (db:test-get-state wtdat) Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -19,25 +19,31 @@ # The NEWTARGET causes some tests to fail. Do not use until this is fixed. NEWTARGET = "$(OS)/$(FS)/$(VER)" TARGET = "ubuntu/nfs/none" -all : unit test1 test2 test3 test4 test5 test6 test7 test8 test9 +all : build unit test1 test2 test3 test4 test5 test6 test7 test8 test9 + +unit : basicserver.log runs.log misc.log + +rel : + cd release;dashboard -rows 25 & + +## basicserver.log : unittests/basicserver.scm +## script -c "./rununittest.sh basicserver $(DEBUG)" basicserver.log -unit : - ./rununittest.sh basicserver $(DEBUG) +%.log : build unittests/%.scm + script -c "./rununittest.sh $* $(DEBUG)" $*.log + if logpro unit.logpro $*.html < $*.log > /dev/null;then echo ALLPASS;else echo ALLFAIL;mv $*.log $*.log.FAIL;fi server : - cd ..;make -j;make install cd fullrun;$(MEGATEST) -server - -debug $(DEBUG) -run-id $(RUNID) stopserver : - cd ..;make -j && make install cd fullrun;$(MEGATEST) -stop-server 0 repl : - cd ..;make -j && make install cd fullrun;$(MEGATEST) -:b -repl test0 : cleanprep cd simplerun ; $(MEGATEST) -server - -debug $(DEBUG) @@ -149,21 +155,27 @@ done;done;done test11 : cd fullrun;time (for a in 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 1 2 3 4 5 6 7 8 9 10 ;do (megatest -test-paths -target %/%/% > /dev/null ) & done; wait; ) -minsetup : +build : ../*.scm + if killall mtest -v ;then sleep 5;killall mtest -v -9;fi cd ..;make -j && make install + touch build + +cleanstart : + killall mtest -v;if [ ! $$? ];then sleep 5;killall mtest -v -9;fi + +minsetup : build mkdir -p mintest/runs mintest/links cd mintest;$(MEGATEST) -stop-server 0 cd mintest;$(MEGATEST) -server - -debug $(DEBUG) > server.log 2> server.log & sleep 3 cd mintest;$(DASHBOARD) -rows 18 & -cleanprep : ../*.scm Makefile */*.config +cleanprep : ../*.scm Makefile */*.config build mkdir -p fullrun/tmp/mt_runs fullrun/tmp/mt_links /tmp/$(USER)/adisk1 - cd ..;make -j;make install rm -f */logging.db touch cleanprep fullprep : cleanprep cd fullrun;$(MEGATEST) -remove-runs :runname $(RUNNAME)% -target %/%/% -testpatt %/% Index: tests/fdktestqa/fdk.config ================================================================== --- tests/fdktestqa/fdk.config +++ tests/fdktestqa/fdk.config @@ -27,10 +27,10 @@ server-query-threshold 0 [jobtools] # launcher nbq -P ch_vp -C SLES11_EM64T_4G -Q /ciaf/fdk -# launcher nbfake -# maxload 4 +launcher nbfake +maxload 4 -launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log +# launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log Index: tests/fdktestqa/testqa/Makefile ================================================================== --- tests/fdktestqa/testqa/Makefile +++ tests/fdktestqa/testqa/Makefile @@ -2,11 +2,11 @@ PATH := $(BINDIR):$(PATH) MEGATEST = $(BINDIR)/megatest DASHBOARD = $(BINDIR)/dashboard NEWDASHBOARD = $(BINDIR)/newdashboard RUNNAME = a - +NUMTESTS = 20 all : $(MEGATEST) -remove-runs -target a/b :runname c -testpatt %/% $(MEGATEST) -runtests % -target a/b :runname c @@ -14,19 +14,20 @@ for tn in a b c d;do \ ($(MEGATEST) -runtests % -target a/b :runname $tn & ) ; \ done bigrun : - $(MEGATEST) -runtests bigrun -target a/bigrun :runname a$(shell date +%V) + NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun -target a/bigrun :runname a$(shell date +%V) bigrun2 : - $(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a$(shell date +%V) + NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun2 -target a/bigrun2 :runname a$(shell date +%V) bigrun3 : - $(MEGATEST) -runtests bigrun3 -target a/bigrun3 :runname $(RUNNAME) + NUMTESTS=$(NUMTESTS) $(MEGATEST) -runtests bigrun3 -target a/bigrun3 :runname $(RUNNAME) dashboard : + mkdir -p ../simpleruns $(DASHBOARD) -rows 20 & newdashboard : $(NEWDASHBOARD) & Index: tests/fullrun/megatest.config ================================================================== --- tests/fullrun/megatest.config +++ tests/fullrun/megatest.config @@ -147,10 +147,13 @@ # XTERM [system xterm] # RUNDEAD [system exit 56] [server] + +# force use of server always +required yes # Use http instead of direct filesystem access transport http # transport fs # transport nmsg @@ -165,15 +168,16 @@ # Three minutes is 0.05 hours # timeout 0.025 timeout 0.061 # faststart; unless no, start server but proceed with writes until server started -faststart yes +faststart no +# faststart yes # Start server when average query takes longer than this # server-query-threshold 55500 -server-query-threshold 100 +server-query-threshold 1000 timeout 0.01 # daemonize yes # hostname #{scheme (get-host-name)} @@ -230,18 +234,27 @@ # /// disk0 /tmp/#{getenv USER}/adisk1 # Uncomment these to emulate a job queue with a long time (look in bin/sleeprunner for the time) [jobtools] -launcher #{scheme (case (string->symbol (conc (getenv "datapath"))) \ - ((none) "nbfake") \ - ((openlava) "bsub") \ - (else "sleeprunner"))} +# launcher #{ scheme (case (string->symbol (conc (getenv "datapath"))) \ +# ((none) "nbfake") \ +# ((openlava) "bsub") \ +# (else "sleeprunner"))} # launcher bsub -q priority -o $MT_TEST_RUN_DIR/openlava.log + +# launcher #{shell if which bsub > /dev/null;then echo bsub -q priority -o openlava.log;else echo sleeprunner;fi} +launcher nbfake [configf:settings trim-trailing-spaces yes] [test] # VAL1 has trailing spaces VAL1 Foo VAL2 ==>#{get test VAL1}Bar<== no spaces between Foo and Bar to pass + +ltest #{scheme (case (string->symbol (conc (getenv "datapath"))) \ + ((none) "nbfake") \ + ((openlava) "bsub") \ + (else "sleeprunner"))} + ADDED tests/release/Makefile Index: tests/release/Makefile ================================================================== --- /dev/null +++ tests/release/Makefile @@ -0,0 +1,10 @@ + + +dashboard : compile + dashboard -rows 24 & + +compile : runs + cd ../..;make -j install + +runs : + mkdir -p runs ADDED tests/release/megatest.config Index: tests/release/megatest.config ================================================================== --- /dev/null +++ tests/release/megatest.config @@ -0,0 +1,22 @@ +[fields] +release TEXT +iteration TEXT + +[setup] +linktree #{getenv MT_RUN_AREA_HOME}/links +max_concurrent_jobs 100 +logviewer (%MTCMD%) 2> /dev/null > /dev/null +# htmlviewercmd firefox -new-window +htmlviewercmd arora + +[jobtools] +# launcher #{shell if which bsub > /dev/null;then echo bsub;else echo nbfake;fi} +launcher nbfake +maxload 2.5 + +[server] +required yes + +[disks] +disk0 #{getenv MT_RUN_AREA_HOME}/runs + ADDED tests/release/runconfigs.config Index: tests/release/runconfigs.config ================================================================== --- /dev/null +++ tests/release/runconfigs.config @@ -0,0 +1,9 @@ +[default] +MTRUNNER #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/../../utils/mtrunner} +MTTESTDIR #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/..} +MTPATH #{shell readlink -f #{getenv MT_RUN_AREA_HOME}/../../bin} + +[v1.60/15] + +[include atwork.config] + ADDED tests/release/tests/fullrun/results.logpro Index: tests/release/tests/fullrun/results.logpro ================================================================== --- /dev/null +++ tests/release/tests/fullrun/results.logpro @@ -0,0 +1,140 @@ +;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com +;; +;; License GPL. + +(define logbody "LogFileBody") + +(define pass-specs '( ;; testname num-expected max-runtime + ("exit_0" 1 20) + ("ezlog_fail_then_pass" 1 20) + ("ezlog_pass" 1 20) + ("ez_pass" 1 20) + ("lineitem_pass" 1 20) + ("priority_1" 1 20) + ("priority_10" 1 20) + ("priority_10_waiton_1" 1 20) + ("priority_3" 1 20) + ("priority_4" 1 20) + ;; ("priority_5" 1 20) + ("priority_6" 1 20) +;; ("priority_7" 1 20) + ("priority_8" 1 20) + ("priority_9" 1 20) + ("runfirst" 7 20) + ("singletest" 1 20) + ("singletest2" 1 20) + ("special" 1 20) + ("sqlitespeed" 10 20) + ("test1" 1 20) + ("test2" 6 20) + ("test_mt_vars" 6 20) + )) + +(define fail-specs '( ;; testname num-expected max-runtime + ("exit_1" 1 20) + ("ez_exit2_fail" 1 20) + ("ez_fail" 1 20) + ("ez_fail_quick" 1 20) + ("ezlog_fail" 1 20) + ("lineitem_fail" 1 20) + ("logpro_required_fail" 1 20) + ("manual_example" 1 20) + ("neverrun" 1 20))) + +(define warn-specs '(("ezlog_warn" 1 20))) + +(define nost-specs '(("wait_no_items1" 1 20) + ("wait_no_items2" 1 20) + ("wait_no_items3" 1 20) + ("wait_no_items4" 1 20) + ;; ("no_items" 1 20) + )) + +(define (check-one-test estate estatus testname count runtime) + (let* ((rxe (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s"))) + (msg1 (conc testname " expecting count of " count)) + (msg2 (conc testname " expecting runtime less than " runtime))) + (expect:required in logbody = count msg1 rxe) + ;;(expect:value in logbody count < msg2 rxe) + )) + +;; Special cases +;; +(expect:ignore in logbody >= 0 "db_sync test might not have run" #/Test: db_sync/) +(expect:ignore in logbody >= 0 "all_toplevel may not yet be done" #/Test: all_toplevel/) +(expect:error in logbody = 0 "tests left in RUNNING state" #/State: RUNNING/) +(expect:required in logbody = 1 "priority_2 is KILLED" #/Test: priority_2\s+State: KILLED\s+Status: KILLED/) +(expect:required in logbody = 1 "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +(expect:required in logbody = 1 "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +(expect:required in logbody = 1 "testxz has 1 NOT_STARTED test" #/Test: testxz\s+State: NOT_STARTED/) +(expect:required in logbody = 1 "no items" #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/) +(expect:warning in logbody = 1 "dynamic waiton" #/Test: dynamic_waiton/) +(expect:required in logbody = 29 "blocktestxz has 29 tests" #/Test: blocktestxz/) + +;; General cases +;; +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "PASS" testdat)) + pass-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "FAIL" testdat)) + fail-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "WARN" testdat)) + warn-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat)) + nost-specs) + +;; Catch all. +;; +(expect:error in logbody = 0 "Tests not accounted for" #/Test: /) + + +;; ;; define your hooks +;; (hook:first-error "echo \"Error hook activated: #{escaped errmsg}\"") +;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"") +;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"") +;; +;; ;; first ensure your run at least started +;; ;; +;; (trigger "Init" #/This is a header/) +;; (trigger "InitEnd" #/^\s*$/) +;; (section "Init" "Init" "InitEnd") +;; +;; (trigger "Body" #/^.*$/) ;; anything starts the body +;; ;; (trigger "EndBody" #/This had better never match/) +;; +;; (section "Body" "Body" "EndBody") +;; +;; (trigger "Blah2" #/^begin Blah2/) +;; (trigger "Blah2End" #/^end Blah2/) +;; (section "Blah2" "Blah2" "Blah2End") +;; +;; (expect:required in "Init" = 1 "Header" #/This is a header/) +;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/) +;; (expect:value in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/) +;; (expect:value in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/) +;; (expect:value in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/) +;; +;; ;; Using match number +;; (expect:value in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; ;; Comparison instead of tolerance +;; (expect:value in "LogFileBody" 1.9 > "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; (expect:ignore in "Blah2" < 99 "FALSE ERROR" #/ERROR/) +;; (expect:ignore in "Body" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +;; (expect:warning in "Body" = 0 "Any warning" #/WARNING/) +;; (expect:error in "Body" = 0 "ERROR BLAH" (list #/ERROR/ #/error/)) ;; but disallow any other errors +;; +;; ;(expect in "Init" < 1 "Junk" #/This is bogus/) ADDED tests/release/tests/fullrun/testconfig Index: tests/release/tests/fullrun/testconfig ================================================================== --- /dev/null +++ tests/release/tests/fullrun/testconfig @@ -0,0 +1,11 @@ +[ezsteps] +cleantop $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -remove-runs -target ubuntu/nfs/none -runname release_toplevel -testpatt % +runall $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt % -target ubuntu/nfs/none -runname release_toplevel -runwait +runtop $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt all_toplevel -target ubuntu/nfs/none -runname release_toplevel -rerun FAIL -preclean -runwait +results $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs release_toplevel -target ubuntu/nfs/none -runname release_toplevel + +[requirements] +# waiton #{getenv ALL_TOPLEVEL_TESTS} + +# This is a "toplevel" test, it does not require waitons to be non-FAIL to run +# mode toplevel ADDED tests/release/tests/itemwait/testconfig Index: tests/release/tests/itemwait/testconfig ================================================================== --- /dev/null +++ tests/release/tests/itemwait/testconfig @@ -0,0 +1,24 @@ +# test2 from the tests/Makefile + +[var] +tname itemwait + +[pre-launch-env-vars] +NUMTESTS 20 + +[ezsteps] + +# Set things up +clean $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH megatest -remove-runs -testpatt % -target %/% -runname #{get var tname}% +runbigrun3 $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH nbfake megatest -run -testpatt bigrun3 -target a/bigrun3 -runname #{get var tname} +# watchrun watches until it sees at least one RUNNING in bigrun and one PASS in bigrun2 +watchrun sleep 15;watchrun.sh #{get var tname} + +[requirements] +# waiton #{getenv ALL_TOPLEVEL_TESTS} + +# This is a "toplevel" test, it does not require waitons to be non-FAIL to run +# mode toplevel + + +# test2 : fullprep ADDED tests/release/tests/itemwait/watchrun.sh Index: tests/release/tests/itemwait/watchrun.sh ================================================================== --- /dev/null +++ tests/release/tests/itemwait/watchrun.sh @@ -0,0 +1,29 @@ +#!/bin/bash + +runname=$1 + +pass=no +alldone=no +while [[ $alldone == no ]];do + sleep 5 + $MTRUNNER $MTTESTDIR/fdktestqa/testqa $MTPATH megatest -list-runs $runname > list-runs.log + bigrun_running=$(cat list-runs.log | egrep 'bigrun\(.*RUNNING'|wc -l) + bigrun2_pass=$(cat list-runs.log | egrep 'bigrun2.*COMPLETED.*PASS'|wc -l) + echo "bigrun_running=$bigrun_running, bigrun2_pass=$bigrun2_pass" + if [[ $bigrun_running -gt 0 ]] && [[ $bigrun2_pass -gt 0 ]];then + pass=yes + alldone=yes + fi + if [[ $bigrun_running -eq 0 ]];then + echo "bigrun all done and no bigrun2 found with PASS." + alldone=yes + fi +done + +if [[ $pass == yes ]];then + echo PASS + exit 0 +else + echo FAIL + exit 1 +fi ADDED tests/release/tests/rollup/firstres.logpro Index: tests/release/tests/rollup/firstres.logpro ================================================================== --- /dev/null +++ tests/release/tests/rollup/firstres.logpro @@ -0,0 +1,144 @@ +;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com +;; +;; License GPL. + +(define logbody "LogFileBody") + +(define pass-specs '( ;; testname num-expected max-runtime + ;; ("exit_0" 1 20) + ;; ("ezlog_fail_then_pass" 1 20) + ;; ("ezlog_pass" 1 20) + ;; ("ez_pass" 1 20) + ;; ("lineitem_pass" 1 20) + ;; ("priority_1" 1 20) + ;; ("priority_10" 1 20) + ;; ("priority_10_waiton_1" 1 20) + ;; ("priority_3" 1 20) + ;; ("priority_4" 1 20) + ;; ;; ("priority_5" 1 20) + ;; ("priority_6" 1 20) +;; ;; ("priority_7" 1 20) + ;; ("priority_8" 1 20) + ;; ("priority_9" 1 20) + ("runfirst" 7 20) + ;; ("singletest" 1 20) + ;; ("singletest2" 1 20) + ;; ("special" 1 20) + ;; ("sqlitespeed" 10 20) + ;; ("test1" 1 20) + ;; ("test2" 6 20) + ;; ("test_mt_vars" 6 20) + )) + +(define fail-specs '( ;; testname num-expected max-runtime + ;; ("exit_1" 1 20) + ;; ("ez_exit2_fail" 1 20) + ;; ("ez_fail" 1 20) + ;; ("ez_fail_quick" 1 20) + ;; ("ezlog_fail" 1 20) + ;; ("lineitem_fail" 1 20) + ;; ("logpro_required_fail" 1 20) + ;; ("manual_example" 1 20) + ;; ("neverrun" 1 20) + )) + +(define warn-specs '( + ;; ("ezlog_warn" 1 20) + )) + +(define nost-specs '( + ;; ("wait_no_items1" 1 20) + ;; ("wait_no_items2" 1 20) + ;; ("wait_no_items3" 1 20) + ;; ("wait_no_items4" 1 20) + ;; ("no_items" 1 20) + )) + +(define (check-one-test estate estatus testname count runtime) + (let* ((rxe (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s"))) + (msg1 (conc testname " expecting count of " count)) + (msg2 (conc testname " expecting runtime less than " runtime))) + (expect:required in logbody = count msg1 rxe) + ;;(expect:value in logbody count < msg2 rxe) + )) + +;; Special cases +;; +;; (expect:ignore in logbody >= 0 "db_sync test might not have run" #/Test: db_sync/) +;; (expect:ignore in logbody >= 0 "all_toplevel may not yet be done" #/Test: all_toplevel/) +(expect:error in logbody = 0 "tests left in RUNNING state" #/State: RUNNING/) +;; (expect:required in logbody = 1 "priority_2 is KILLED" #/Test: priority_2\s+State: KILLED\s+Status: KILLED/) +;; (expect:required in logbody = 1 "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "testxz has 1 NOT_STARTED test" #/Test: testxz\s+State: NOT_STARTED/) +;; (expect:required in logbody = 1 "no items" #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/) +;; (expect:warning in logbody = 1 "dynamic waiton" #/Test: dynamic_waiton/) +;; (expect:required in logbody = 29 "blocktestxz has 29 tests" #/Test: blocktestxz/) + +;; General cases +;; +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "PASS" testdat)) + pass-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "FAIL" testdat)) + fail-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "WARN" testdat)) + warn-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat)) + nost-specs) + +;; Catch all. +;; +(expect:error in logbody = 0 "Tests not accounted for" #/Test: /) + + +;; ;; define your hooks +;; (hook:first-error "echo \"Error hook activated: #{escaped errmsg}\"") +;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"") +;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"") +;; +;; ;; first ensure your run at least started +;; ;; +;; (trigger "Init" #/This is a header/) +;; (trigger "InitEnd" #/^\s*$/) +;; (section "Init" "Init" "InitEnd") +;; +;; (trigger "Body" #/^.*$/) ;; anything starts the body +;; ;; (trigger "EndBody" #/This had better never match/) +;; +;; (section "Body" "Body" "EndBody") +;; +;; (trigger "Blah2" #/^begin Blah2/) +;; (trigger "Blah2End" #/^end Blah2/) +;; (section "Blah2" "Blah2" "Blah2End") +;; +;; (expect:required in "Init" = 1 "Header" #/This is a header/) +;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/) +;; (expect:value in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/) +;; (expect:value in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/) +;; (expect:value in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/) +;; +;; ;; Using match number +;; (expect:value in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; ;; Comparison instead of tolerance +;; (expect:value in "LogFileBody" 1.9 > "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; (expect:ignore in "Blah2" < 99 "FALSE ERROR" #/ERROR/) +;; (expect:ignore in "Body" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +;; (expect:warning in "Body" = 0 "Any warning" #/WARNING/) +;; (expect:error in "Body" = 0 "ERROR BLAH" (list #/ERROR/ #/error/)) ;; but disallow any other errors +;; +;; ;(expect in "Init" < 1 "Junk" #/This is bogus/) ADDED tests/release/tests/rollup/results.logpro Index: tests/release/tests/rollup/results.logpro ================================================================== --- /dev/null +++ tests/release/tests/rollup/results.logpro @@ -0,0 +1,145 @@ +;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com +;; +;; License GPL. + +(define logbody "LogFileBody") + +(define pass-specs '( ;; testname num-expected max-runtime + ;; ("exit_0" 1 20) + ;; ("ezlog_fail_then_pass" 1 20) + ;; ("ezlog_pass" 1 20) + ;; ("ez_pass" 1 20) + ;; ("lineitem_pass" 1 20) + ;; ("priority_1" 1 20) + ;; ("priority_10" 1 20) + ;; ("priority_10_waiton_1" 1 20) + ;; ("priority_3" 1 20) + ;; ("priority_4" 1 20) + ;; ;; ("priority_5" 1 20) + ;; ("priority_6" 1 20) +;; ;; ("priority_7" 1 20) + ;; ("priority_8" 1 20) + ;; ("priority_9" 1 20) + ("runfirst" 5 20) + ;; ("singletest" 1 20) + ;; ("singletest2" 1 20) + ;; ("special" 1 20) + ;; ("sqlitespeed" 10 20) + ;; ("test1" 1 20) + ;; ("test2" 6 20) + ;; ("test_mt_vars" 6 20) + )) + +(define fail-specs '( ;; testname num-expected max-runtime + ;; ("exit_1" 1 20) + ;; ("ez_exit2_fail" 1 20) + ;; ("ez_fail" 1 20) + ;; ("ez_fail_quick" 1 20) + ;; ("ezlog_fail" 1 20) + ;; ("lineitem_fail" 1 20) + ;; ("logpro_required_fail" 1 20) + ;; ("manual_example" 1 20) + ;; ("neverrun" 1 20) + )) + +(define warn-specs '( + ;; ("ezlog_warn" 1 20) + )) + +(define nost-specs '( + ;; ("wait_no_items1" 1 20) + ;; ("wait_no_items2" 1 20) + ;; ("wait_no_items3" 1 20) + ;; ("wait_no_items4" 1 20) + ;; ("no_items" 1 20) + )) + +(define (check-one-test estate estatus testname count runtime) + (let* ((rxe (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s"))) + (msg1 (conc testname " expecting count of " count)) + (msg2 (conc testname " expecting runtime less than " runtime))) + (expect:required in logbody = count msg1 rxe) + ;;(expect:value in logbody count < msg2 rxe) + )) + +;; Special cases +;; +;; (expect:ignore in logbody >= 0 "db_sync test might not have run" #/Test: db_sync/) +;; (expect:ignore in logbody >= 0 "all_toplevel may not yet be done" #/Test: all_toplevel/) +(expect:error in logbody = 0 "tests left in RUNNING state" #/State: RUNNING/) +;; (expect:required in logbody = 1 "priority_2 is KILLED" #/Test: priority_2\s+State: KILLED\s+Status: KILLED/) +;; (expect:required in logbody = 1 "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +(expect:required in logbody = 1 "Toplevel will be NOT_STARTED" #/Test: runfirst\s+State: (INCOMPLETE|NOT_STARTED)/) +(expect:required in logbody = 1 "runfirst/b/2 will be NOT_STARTED/INCOMPLETE" #/Test: runfirst.b.2.\s+State: NOT_STARTED\s+Status: INCOMPLETE/) +;; (expect:required in logbody = 1 "no items" #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/) +;; (expect:warning in logbody = 1 "dynamic waiton" #/Test: dynamic_waiton/) +;; (expect:required in logbody = 29 "blocktestxz has 29 tests" #/Test: blocktestxz/) + +;; General cases +;; +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "PASS" testdat)) + pass-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "FAIL" testdat)) + fail-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "WARN" testdat)) + warn-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat)) + nost-specs) + +;; Catch all. +;; +(expect:error in logbody = 0 "Tests not accounted for" #/Test: /) + + +;; ;; define your hooks +;; (hook:first-error "echo \"Error hook activated: #{escaped errmsg}\"") +;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"") +;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"") +;; +;; ;; first ensure your run at least started +;; ;; +;; (trigger "Init" #/This is a header/) +;; (trigger "InitEnd" #/^\s*$/) +;; (section "Init" "Init" "InitEnd") +;; +;; (trigger "Body" #/^.*$/) ;; anything starts the body +;; ;; (trigger "EndBody" #/This had better never match/) +;; +;; (section "Body" "Body" "EndBody") +;; +;; (trigger "Blah2" #/^begin Blah2/) +;; (trigger "Blah2End" #/^end Blah2/) +;; (section "Blah2" "Blah2" "Blah2End") +;; +;; (expect:required in "Init" = 1 "Header" #/This is a header/) +;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/) +;; (expect:value in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/) +;; (expect:value in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/) +;; (expect:value in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/) +;; +;; ;; Using match number +;; (expect:value in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; ;; Comparison instead of tolerance +;; (expect:value in "LogFileBody" 1.9 > "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; (expect:ignore in "Blah2" < 99 "FALSE ERROR" #/ERROR/) +;; (expect:ignore in "Body" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +;; (expect:warning in "Body" = 0 "Any warning" #/WARNING/) +;; (expect:error in "Body" = 0 "ERROR BLAH" (list #/ERROR/ #/error/)) ;; but disallow any other errors +;; +;; ;(expect in "Init" < 1 "Junk" #/This is bogus/) ADDED tests/release/tests/rollup/testconfig Index: tests/release/tests/rollup/testconfig ================================================================== --- /dev/null +++ tests/release/tests/rollup/testconfig @@ -0,0 +1,28 @@ +# test2 from the tests/Makefile + +[var] +tname rollup + +[ezsteps] + +# Set things up +clean $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -remove-runs -testpatt % -target ubuntu/nfs/none -runname #{get var tname}% +runfirst $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -runtests runfirst/% -reqtarg ubuntu/nfs/none -runname #{get var tname} -preclean +firstres $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname} -target ubuntu/nfs/none + +# Set one test item to INCOMPLETE +setstate $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -set-state-status INCOMPLETE,FAIL :state COMPLETED :status PASS -testpatt runfirst/b/2 -target ubuntu/nfs/none -runname #{get var tname} + +# Rerun a different test item +rerun $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt runfirst/spring -reqtarg ubuntu/nfs/none -runname #{get var tname} -preclean -rerun PASS + +results $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname} -target ubuntu/nfs/none + +[requirements] +# waiton #{getenv ALL_TOPLEVEL_TESTS} + +# This is a "toplevel" test, it does not require waitons to be non-FAIL to run +# mode toplevel + + +# test2 : fullprep ADDED tests/release/tests/test2/results.logpro Index: tests/release/tests/test2/results.logpro ================================================================== --- /dev/null +++ tests/release/tests/test2/results.logpro @@ -0,0 +1,144 @@ +;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com +;; +;; License GPL. + +(define logbody "LogFileBody") + +(define pass-specs '( ;; testname num-expected max-runtime + ;; ("exit_0" 1 20) + ;; ("ezlog_fail_then_pass" 1 20) + ;; ("ezlog_pass" 1 20) + ;; ("ez_pass" 1 20) + ;; ("lineitem_pass" 1 20) + ;; ("priority_1" 1 20) + ;; ("priority_10" 1 20) + ;; ("priority_10_waiton_1" 1 20) + ;; ("priority_3" 1 20) + ;; ("priority_4" 1 20) + ;; ;; ("priority_5" 1 20) + ;; ("priority_6" 1 20) +;; ;; ("priority_7" 1 20) + ;; ("priority_8" 1 20) + ;; ("priority_9" 1 20) + ("runfirst" 2 20) + ;; ("singletest" 1 20) + ;; ("singletest2" 1 20) + ;; ("special" 1 20) + ;; ("sqlitespeed" 10 20) + ;; ("test1" 1 20) + ;; ("test2" 6 20) + ;; ("test_mt_vars" 6 20) + )) + +(define fail-specs '( ;; testname num-expected max-runtime + ;; ("exit_1" 1 20) + ;; ("ez_exit2_fail" 1 20) + ;; ("ez_fail" 1 20) + ;; ("ez_fail_quick" 1 20) + ;; ("ezlog_fail" 1 20) + ;; ("lineitem_fail" 1 20) + ;; ("logpro_required_fail" 1 20) + ;; ("manual_example" 1 20) + ;; ("neverrun" 1 20) + )) + +(define warn-specs '( + ;; ("ezlog_warn" 1 20) + )) + +(define nost-specs '( + ;; ("wait_no_items1" 1 20) + ;; ("wait_no_items2" 1 20) + ;; ("wait_no_items3" 1 20) + ;; ("wait_no_items4" 1 20) + ;; ("no_items" 1 20) + )) + +(define (check-one-test estate estatus testname count runtime) + (let* ((rxe (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s"))) + (msg1 (conc testname " expecting count of " count)) + (msg2 (conc testname " expecting runtime less than " runtime))) + (expect:required in logbody = count msg1 rxe) + ;;(expect:value in logbody count < msg2 rxe) + )) + +;; Special cases +;; +;; (expect:ignore in logbody >= 0 "db_sync test might not have run" #/Test: db_sync/) +;; (expect:ignore in logbody >= 0 "all_toplevel may not yet be done" #/Test: all_toplevel/) +(expect:error in logbody = 0 "tests left in RUNNING state" #/State: RUNNING/) +;; (expect:required in logbody = 1 "priority_2 is KILLED" #/Test: priority_2\s+State: KILLED\s+Status: KILLED/) +;; (expect:required in logbody = 1 "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "testxz has 1 NOT_STARTED test" #/Test: testxz\s+State: NOT_STARTED/) +;; (expect:required in logbody = 1 "no items" #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/) +;; (expect:warning in logbody = 1 "dynamic waiton" #/Test: dynamic_waiton/) +;; (expect:required in logbody = 29 "blocktestxz has 29 tests" #/Test: blocktestxz/) + +;; General cases +;; +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "PASS" testdat)) + pass-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "FAIL" testdat)) + fail-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "WARN" testdat)) + warn-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat)) + nost-specs) + +;; Catch all. +;; +(expect:error in logbody = 0 "Tests not accounted for" #/Test: /) + + +;; ;; define your hooks +;; (hook:first-error "echo \"Error hook activated: #{escaped errmsg}\"") +;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"") +;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"") +;; +;; ;; first ensure your run at least started +;; ;; +;; (trigger "Init" #/This is a header/) +;; (trigger "InitEnd" #/^\s*$/) +;; (section "Init" "Init" "InitEnd") +;; +;; (trigger "Body" #/^.*$/) ;; anything starts the body +;; ;; (trigger "EndBody" #/This had better never match/) +;; +;; (section "Body" "Body" "EndBody") +;; +;; (trigger "Blah2" #/^begin Blah2/) +;; (trigger "Blah2End" #/^end Blah2/) +;; (section "Blah2" "Blah2" "Blah2End") +;; +;; (expect:required in "Init" = 1 "Header" #/This is a header/) +;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/) +;; (expect:value in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/) +;; (expect:value in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/) +;; (expect:value in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/) +;; +;; ;; Using match number +;; (expect:value in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; ;; Comparison instead of tolerance +;; (expect:value in "LogFileBody" 1.9 > "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; (expect:ignore in "Blah2" < 99 "FALSE ERROR" #/ERROR/) +;; (expect:ignore in "Body" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +;; (expect:warning in "Body" = 0 "Any warning" #/WARNING/) +;; (expect:error in "Body" = 0 "ERROR BLAH" (list #/ERROR/ #/error/)) ;; but disallow any other errors +;; +;; ;(expect in "Init" < 1 "Junk" #/This is bogus/) ADDED tests/release/tests/test2/results_a.logpro Index: tests/release/tests/test2/results_a.logpro ================================================================== --- /dev/null +++ tests/release/tests/test2/results_a.logpro @@ -0,0 +1,144 @@ +;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com +;; +;; License GPL. + +(define logbody "LogFileBody") + +(define pass-specs '( ;; testname num-expected max-runtime + ;; ("exit_0" 1 20) + ;; ("ezlog_fail_then_pass" 1 20) + ;; ("ezlog_pass" 1 20) + ;; ("ez_pass" 1 20) + ;; ("lineitem_pass" 1 20) + ;; ("priority_1" 1 20) + ;; ("priority_10" 1 20) + ;; ("priority_10_waiton_1" 1 20) + ;; ("priority_3" 1 20) + ;; ("priority_4" 1 20) + ;; ;; ("priority_5" 1 20) + ;; ("priority_6" 1 20) +;; ;; ("priority_7" 1 20) + ;; ("priority_8" 1 20) + ;; ("priority_9" 1 20) + ("runfirst" 2 20) + ;; ("singletest" 1 20) + ;; ("singletest2" 1 20) + ;; ("special" 1 20) + ;; ("sqlitespeed" 10 20) + ;; ("test1" 1 20) + ;; ("test2" 6 20) + ;; ("test_mt_vars" 6 20) + )) + +(define fail-specs '( ;; testname num-expected max-runtime + ;; ("exit_1" 1 20) + ;; ("ez_exit2_fail" 1 20) + ;; ("ez_fail" 1 20) + ;; ("ez_fail_quick" 1 20) + ;; ("ezlog_fail" 1 20) + ;; ("lineitem_fail" 1 20) + ;; ("logpro_required_fail" 1 20) + ;; ("manual_example" 1 20) + ;; ("neverrun" 1 20) + )) + +(define warn-specs '( + ;; ("ezlog_warn" 1 20) + )) + +(define nost-specs '( + ;; ("wait_no_items1" 1 20) + ;; ("wait_no_items2" 1 20) + ;; ("wait_no_items3" 1 20) + ;; ("wait_no_items4" 1 20) + ;; ("no_items" 1 20) + )) + +(define (check-one-test estate estatus testname count runtime) + (let* ((rxe (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s"))) + (msg1 (conc testname " expecting count of " count)) + (msg2 (conc testname " expecting runtime less than " runtime))) + (expect:required in logbody = count msg1 rxe) + ;;(expect:value in logbody count < msg2 rxe) + )) + +;; Special cases +;; +;; (expect:ignore in logbody >= 0 "db_sync test might not have run" #/Test: db_sync/) +;; (expect:ignore in logbody >= 0 "all_toplevel may not yet be done" #/Test: all_toplevel/) +(expect:error in logbody = 0 "tests left in RUNNING state" #/State: RUNNING/) +;; (expect:required in logbody = 1 "priority_2 is KILLED" #/Test: priority_2\s+State: KILLED\s+Status: KILLED/) +;; (expect:required in logbody = 1 "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "testxz has 1 NOT_STARTED test" #/Test: testxz\s+State: NOT_STARTED/) +;; (expect:required in logbody = 1 "no items" #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/) +;; (expect:warning in logbody = 1 "dynamic waiton" #/Test: dynamic_waiton/) +;; (expect:required in logbody = 29 "blocktestxz has 29 tests" #/Test: blocktestxz/) + +;; General cases +;; +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "PASS" testdat)) + pass-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "FAIL" testdat)) + fail-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "WARN" testdat)) + warn-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat)) + nost-specs) + +;; Catch all. +;; +(expect:error in logbody = 0 "Tests not accounted for" #/Test: /) + + +;; ;; define your hooks +;; (hook:first-error "echo \"Error hook activated: #{escaped errmsg}\"") +;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"") +;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"") +;; +;; ;; first ensure your run at least started +;; ;; +;; (trigger "Init" #/This is a header/) +;; (trigger "InitEnd" #/^\s*$/) +;; (section "Init" "Init" "InitEnd") +;; +;; (trigger "Body" #/^.*$/) ;; anything starts the body +;; ;; (trigger "EndBody" #/This had better never match/) +;; +;; (section "Body" "Body" "EndBody") +;; +;; (trigger "Blah2" #/^begin Blah2/) +;; (trigger "Blah2End" #/^end Blah2/) +;; (section "Blah2" "Blah2" "Blah2End") +;; +;; (expect:required in "Init" = 1 "Header" #/This is a header/) +;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/) +;; (expect:value in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/) +;; (expect:value in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/) +;; (expect:value in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/) +;; +;; ;; Using match number +;; (expect:value in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; ;; Comparison instead of tolerance +;; (expect:value in "LogFileBody" 1.9 > "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; (expect:ignore in "Blah2" < 99 "FALSE ERROR" #/ERROR/) +;; (expect:ignore in "Body" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +;; (expect:warning in "Body" = 0 "Any warning" #/WARNING/) +;; (expect:error in "Body" = 0 "ERROR BLAH" (list #/ERROR/ #/error/)) ;; but disallow any other errors +;; +;; ;(expect in "Init" < 1 "Junk" #/This is bogus/) ADDED tests/release/tests/test2/results_b.logpro Index: tests/release/tests/test2/results_b.logpro ================================================================== --- /dev/null +++ tests/release/tests/test2/results_b.logpro @@ -0,0 +1,144 @@ +;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com +;; +;; License GPL. + +(define logbody "LogFileBody") + +(define pass-specs '( ;; testname num-expected max-runtime + ;; ("exit_0" 1 20) + ;; ("ezlog_fail_then_pass" 1 20) + ;; ("ezlog_pass" 1 20) + ;; ("ez_pass" 1 20) + ;; ("lineitem_pass" 1 20) + ;; ("priority_1" 1 20) + ;; ("priority_10" 1 20) + ;; ("priority_10_waiton_1" 1 20) + ;; ("priority_3" 1 20) + ;; ("priority_4" 1 20) + ;; ;; ("priority_5" 1 20) + ;; ("priority_6" 1 20) +;; ;; ("priority_7" 1 20) + ;; ("priority_8" 1 20) + ;; ("priority_9" 1 20) + ("runfirst" 2 20) + ;; ("singletest" 1 20) + ;; ("singletest2" 1 20) + ;; ("special" 1 20) + ;; ("sqlitespeed" 10 20) + ;; ("test1" 1 20) + ;; ("test2" 6 20) + ;; ("test_mt_vars" 6 20) + )) + +(define fail-specs '( ;; testname num-expected max-runtime + ;; ("exit_1" 1 20) + ;; ("ez_exit2_fail" 1 20) + ;; ("ez_fail" 1 20) + ;; ("ez_fail_quick" 1 20) + ;; ("ezlog_fail" 1 20) + ;; ("lineitem_fail" 1 20) + ;; ("logpro_required_fail" 1 20) + ;; ("manual_example" 1 20) + ;; ("neverrun" 1 20) + )) + +(define warn-specs '( + ;; ("ezlog_warn" 1 20) + )) + +(define nost-specs '( + ;; ("wait_no_items1" 1 20) + ;; ("wait_no_items2" 1 20) + ;; ("wait_no_items3" 1 20) + ;; ("wait_no_items4" 1 20) + ;; ("no_items" 1 20) + )) + +(define (check-one-test estate estatus testname count runtime) + (let* ((rxe (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s"))) + (msg1 (conc testname " expecting count of " count)) + (msg2 (conc testname " expecting runtime less than " runtime))) + (expect:required in logbody = count msg1 rxe) + ;;(expect:value in logbody count < msg2 rxe) + )) + +;; Special cases +;; +;; (expect:ignore in logbody >= 0 "db_sync test might not have run" #/Test: db_sync/) +;; (expect:ignore in logbody >= 0 "all_toplevel may not yet be done" #/Test: all_toplevel/) +(expect:error in logbody = 0 "tests left in RUNNING state" #/State: RUNNING/) +;; (expect:required in logbody = 1 "priority_2 is KILLED" #/Test: priority_2\s+State: KILLED\s+Status: KILLED/) +;; (expect:required in logbody = 1 "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "testxz has 1 NOT_STARTED test" #/Test: testxz\s+State: NOT_STARTED/) +;; (expect:required in logbody = 1 "no items" #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/) +;; (expect:warning in logbody = 1 "dynamic waiton" #/Test: dynamic_waiton/) +;; (expect:required in logbody = 29 "blocktestxz has 29 tests" #/Test: blocktestxz/) + +;; General cases +;; +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "PASS" testdat)) + pass-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "FAIL" testdat)) + fail-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "WARN" testdat)) + warn-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat)) + nost-specs) + +;; Catch all. +;; +(expect:error in logbody = 0 "Tests not accounted for" #/Test: /) + + +;; ;; define your hooks +;; (hook:first-error "echo \"Error hook activated: #{escaped errmsg}\"") +;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"") +;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"") +;; +;; ;; first ensure your run at least started +;; ;; +;; (trigger "Init" #/This is a header/) +;; (trigger "InitEnd" #/^\s*$/) +;; (section "Init" "Init" "InitEnd") +;; +;; (trigger "Body" #/^.*$/) ;; anything starts the body +;; ;; (trigger "EndBody" #/This had better never match/) +;; +;; (section "Body" "Body" "EndBody") +;; +;; (trigger "Blah2" #/^begin Blah2/) +;; (trigger "Blah2End" #/^end Blah2/) +;; (section "Blah2" "Blah2" "Blah2End") +;; +;; (expect:required in "Init" = 1 "Header" #/This is a header/) +;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/) +;; (expect:value in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/) +;; (expect:value in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/) +;; (expect:value in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/) +;; +;; ;; Using match number +;; (expect:value in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; ;; Comparison instead of tolerance +;; (expect:value in "LogFileBody" 1.9 > "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; (expect:ignore in "Blah2" < 99 "FALSE ERROR" #/ERROR/) +;; (expect:ignore in "Body" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +;; (expect:warning in "Body" = 0 "Any warning" #/WARNING/) +;; (expect:error in "Body" = 0 "ERROR BLAH" (list #/ERROR/ #/error/)) ;; but disallow any other errors +;; +;; ;(expect in "Init" < 1 "Junk" #/This is bogus/) ADDED tests/release/tests/test2/testconfig Index: tests/release/tests/test2/testconfig ================================================================== --- /dev/null +++ tests/release/tests/test2/testconfig @@ -0,0 +1,27 @@ +# test2 from the tests/Makefile + +[var] +tname test2 +mtpath #{shell readlink -f ../../bin} + +[ezsteps] +clean $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -remove-runs -testpatt % -target ubuntu/nfs/none -runname #{get var tname}% +part1 $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt ez_pass,runfirst/a/% -reqtarg ubuntu/nfs/none -runname #{get var tname} -preclean +part2 $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt %/,%/ai -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean +part3 $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -runtests %/,%/ai -reqtarg ubuntu/nfs/none -runname #{get var tname}_b -preclean +part4 $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt runfirst/%,%/ai -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean +part5 $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt %/,%/winter -reqtarg ubuntu/nfs/none -runname #{get var tname}_a -preclean +part6 $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -set-state-status COMPLETED,FORCED :state COMPLETED :status PASS -testpatt ez_p%s,runfirst/ -target ubuntu/nfs/none -runname #{get var tname} + +results $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname} -target ubuntu/nfs/none +results_a $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname}_a -target ubuntu/nfs/none +results_b $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs #{get var tname}_b -target ubuntu/nfs/none + +[requirements] +# waiton #{getenv ALL_TOPLEVEL_TESTS} + +# This is a "toplevel" test, it does not require waitons to be non-FAIL to run +# mode toplevel + + +# test2 : fullprep ADDED tests/release/tests/testpatt/cleanres.logpro Index: tests/release/tests/testpatt/cleanres.logpro ================================================================== --- /dev/null +++ tests/release/tests/testpatt/cleanres.logpro @@ -0,0 +1,144 @@ +;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com +;; +;; License GPL. + +(define logbody "LogFileBody") + +(define pass-specs '( ;; testname num-expected max-runtime + ;; ("exit_0" 1 20) + ;; ("ezlog_fail_then_pass" 1 20) + ;; ("ezlog_pass" 1 20) + ;; ("ez_pass" 1 20) + ;; ("lineitem_pass" 1 20) + ;; ("priority_1" 1 20) + ;; ("priority_10" 1 20) + ;; ("priority_10_waiton_1" 1 20) + ;; ("priority_3" 1 20) + ;; ("priority_4" 1 20) + ;; ;; ("priority_5" 1 20) + ;; ("priority_6" 1 20) +;; ;; ("priority_7" 1 20) + ;; ("priority_8" 1 20) + ;; ("priority_9" 1 20) + ;; ("runfirst" 2 20) + ;; ("singletest" 1 20) + ;; ("singletest2" 1 20) + ;; ("special" 1 20) + ;; ("sqlitespeed" 10 20) + ;; ("test1" 1 20) + ;; ("test2" 6 20) + ;; ("test_mt_vars" 6 20) + )) + +(define fail-specs '( ;; testname num-expected max-runtime + ;; ("exit_1" 1 20) + ;; ("ez_exit2_fail" 1 20) + ;; ("ez_fail" 1 20) + ;; ("ez_fail_quick" 1 20) + ;; ("ezlog_fail" 1 20) + ;; ("lineitem_fail" 1 20) + ;; ("logpro_required_fail" 1 20) + ;; ("manual_example" 1 20) + ;; ("neverrun" 1 20) + )) + +(define warn-specs '( + ;; ("ezlog_warn" 1 20) + )) + +(define nost-specs '( + ;; ("wait_no_items1" 1 20) + ;; ("wait_no_items2" 1 20) + ;; ("wait_no_items3" 1 20) + ;; ("wait_no_items4" 1 20) + ;; ("no_items" 1 20) + )) + +(define (check-one-test estate estatus testname count runtime) + (let* ((rxe (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s"))) + (msg1 (conc testname " expecting count of " count)) + (msg2 (conc testname " expecting runtime less than " runtime))) + (expect:required in logbody = count msg1 rxe) + ;;(expect:value in logbody count < msg2 rxe) + )) + +;; Special cases +;; +;; (expect:ignore in logbody >= 0 "db_sync test might not have run" #/Test: db_sync/) +;; (expect:ignore in logbody >= 0 "all_toplevel may not yet be done" #/Test: all_toplevel/) +(expect:error in logbody = 0 "tests left in RUNNING state" #/State: RUNNING/) +;; (expect:required in logbody = 1 "priority_2 is KILLED" #/Test: priority_2\s+State: KILLED\s+Status: KILLED/) +;; (expect:required in logbody = 1 "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "testxz has 1 NOT_STARTED test" #/Test: testxz\s+State: NOT_STARTED/) +;; (expect:required in logbody = 1 "no items" #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/) +;; (expect:warning in logbody = 1 "dynamic waiton" #/Test: dynamic_waiton/) +;; (expect:required in logbody = 29 "blocktestxz has 29 tests" #/Test: blocktestxz/) + +;; General cases +;; +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "PASS" testdat)) + pass-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "FAIL" testdat)) + fail-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "WARN" testdat)) + warn-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat)) + nost-specs) + +;; Catch all. +;; +(expect:error in logbody = 0 "Tests not accounted for" #/Test: /) + + +;; ;; define your hooks +;; (hook:first-error "echo \"Error hook activated: #{escaped errmsg}\"") +;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"") +;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"") +;; +;; ;; first ensure your run at least started +;; ;; +;; (trigger "Init" #/This is a header/) +;; (trigger "InitEnd" #/^\s*$/) +;; (section "Init" "Init" "InitEnd") +;; +;; (trigger "Body" #/^.*$/) ;; anything starts the body +;; ;; (trigger "EndBody" #/This had better never match/) +;; +;; (section "Body" "Body" "EndBody") +;; +;; (trigger "Blah2" #/^begin Blah2/) +;; (trigger "Blah2End" #/^end Blah2/) +;; (section "Blah2" "Blah2" "Blah2End") +;; +;; (expect:required in "Init" = 1 "Header" #/This is a header/) +;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/) +;; (expect:value in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/) +;; (expect:value in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/) +;; (expect:value in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/) +;; +;; ;; Using match number +;; (expect:value in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; ;; Comparison instead of tolerance +;; (expect:value in "LogFileBody" 1.9 > "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; (expect:ignore in "Blah2" < 99 "FALSE ERROR" #/ERROR/) +;; (expect:ignore in "Body" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +;; (expect:warning in "Body" = 0 "Any warning" #/WARNING/) +;; (expect:error in "Body" = 0 "ERROR BLAH" (list #/ERROR/ #/error/)) ;; but disallow any other errors +;; +;; ;(expect in "Init" < 1 "Junk" #/This is bogus/) ADDED tests/release/tests/testpatt/results.logpro Index: tests/release/tests/testpatt/results.logpro ================================================================== --- /dev/null +++ tests/release/tests/testpatt/results.logpro @@ -0,0 +1,144 @@ +;; (c) 2006,2007,2008,2009 Matthew Welland matt@kiatoa.com +;; +;; License GPL. + +(define logbody "LogFileBody") + +(define pass-specs '( ;; testname num-expected max-runtime + ;; ("exit_0" 1 20) + ;; ("ezlog_fail_then_pass" 1 20) + ;; ("ezlog_pass" 1 20) + ;; ("ez_pass" 1 20) + ;; ("lineitem_pass" 1 20) + ;; ("priority_1" 1 20) + ;; ("priority_10" 1 20) + ;; ("priority_10_waiton_1" 1 20) + ;; ("priority_3" 1 20) + ;; ("priority_4" 1 20) + ;; ;; ("priority_5" 1 20) + ;; ("priority_6" 1 20) +;; ;; ("priority_7" 1 20) + ;; ("priority_8" 1 20) + ;; ("priority_9" 1 20) + ("runfirst" 2 20) + ;; ("singletest" 1 20) + ;; ("singletest2" 1 20) + ;; ("special" 1 20) + ;; ("sqlitespeed" 10 20) + ;; ("test1" 1 20) + ;; ("test2" 6 20) + ;; ("test_mt_vars" 6 20) + )) + +(define fail-specs '( ;; testname num-expected max-runtime + ;; ("exit_1" 1 20) + ;; ("ez_exit2_fail" 1 20) + ;; ("ez_fail" 1 20) + ;; ("ez_fail_quick" 1 20) + ;; ("ezlog_fail" 1 20) + ;; ("lineitem_fail" 1 20) + ;; ("logpro_required_fail" 1 20) + ;; ("manual_example" 1 20) + ;; ("neverrun" 1 20) + )) + +(define warn-specs '( + ;; ("ezlog_warn" 1 20) + )) + +(define nost-specs '( + ;; ("wait_no_items1" 1 20) + ;; ("wait_no_items2" 1 20) + ;; ("wait_no_items3" 1 20) + ;; ("wait_no_items4" 1 20) + ;; ("no_items" 1 20) + )) + +(define (check-one-test estate estatus testname count runtime) + (let* ((rxe (regexp (conc "^\\s+Test: " testname "(\\(.*|\\s+)\\s+State: " estate "\\s+Status: " estatus "\\s+Runtime:\\s+(\\d+)s"))) + (msg1 (conc testname " expecting count of " count)) + (msg2 (conc testname " expecting runtime less than " runtime))) + (expect:required in logbody = count msg1 rxe) + ;;(expect:value in logbody count < msg2 rxe) + )) + +;; Special cases +;; +;; (expect:ignore in logbody >= 0 "db_sync test might not have run" #/Test: db_sync/) +;; (expect:ignore in logbody >= 0 "all_toplevel may not yet be done" #/Test: all_toplevel/) +(expect:error in logbody = 0 "tests left in RUNNING state" #/State: RUNNING/) +;; (expect:required in logbody = 1 "priority_2 is KILLED" #/Test: priority_2\s+State: KILLED\s+Status: KILLED/) +;; (expect:required in logbody = 1 "priority_5 is either PASS or SKIP" #/Test: priority_5\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "priority_7 is either PASS or SKIP" #/Test: priority_7\s+State: COMPLETED\s+Status: (SKIP|PASS)/) +;; (expect:required in logbody = 1 "testxz has 1 NOT_STARTED test" #/Test: testxz\s+State: NOT_STARTED/) +;; (expect:required in logbody = 1 "no items" #/Test: no_items\s+State: NOT_STARTED\s+Status: ZERO_ITEMS/) +;; (expect:warning in logbody = 1 "dynamic waiton" #/Test: dynamic_waiton/) +;; (expect:required in logbody = 29 "blocktestxz has 29 tests" #/Test: blocktestxz/) + +;; General cases +;; +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "PASS" testdat)) + pass-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "FAIL" testdat)) + fail-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "COMPLETED" "WARN" testdat)) + warn-specs) + +(for-each + (lambda (testdat) + (apply check-one-test "NOT_STARTED" "PREQ_DISCARDED" testdat)) + nost-specs) + +;; Catch all. +;; +(expect:error in logbody = 0 "Tests not accounted for" #/Test: /) + + +;; ;; define your hooks +;; (hook:first-error "echo \"Error hook activated: #{escaped errmsg}\"") +;; (hook:first-warning "echo \"Got warning: #{escaped warnmsg}\"") +;; (hook:value "echo \"Value hook activated: expected=#{expected}, measured=#{measured}, tolerance=#{tolerance}, message=#{message}\"") +;; +;; ;; first ensure your run at least started +;; ;; +;; (trigger "Init" #/This is a header/) +;; (trigger "InitEnd" #/^\s*$/) +;; (section "Init" "Init" "InitEnd") +;; +;; (trigger "Body" #/^.*$/) ;; anything starts the body +;; ;; (trigger "EndBody" #/This had better never match/) +;; +;; (section "Body" "Body" "EndBody") +;; +;; (trigger "Blah2" #/^begin Blah2/) +;; (trigger "Blah2End" #/^end Blah2/) +;; (section "Blah2" "Blah2" "Blah2End") +;; +;; (expect:required in "Init" = 1 "Header" #/This is a header/) +;; (expect:required in "LogFileBody" > 0 "Something required but not found" #/This is required but not found/) +;; (expect:value in "LogFileBody" 1.9 0.1 "Output voltage" #/Measured voltage output:\s*([\d\.\+\-e]+)v/) +;; (expect:value in "LogFileBody" 0.5 0.1 "Output current" #/Measured output current:\s*([\d\.\+\-e]+)mA/) +;; (expect:value in "LogFileBody" 110e9 2e9 "A big number (first)" #/Freq:\s*([\d\.\+\-e]+)\s+Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (second), hook not called" #/Freq:\s*([\d\.\+\-e]+)Hz/) +;; (expect:value in "LogFileBody" 110e9 1e9 "A big number (never activated)" #/Freq:\s*([\d\.\+\-e]+)zH/) +;; +;; ;; Using match number +;; (expect:value in "LogFileBody" 1.9 0.1 "Time Voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; ;; Comparison instead of tolerance +;; (expect:value in "LogFileBody" 1.9 > "Time voltage" #/out: (\d+)\s+(\d+)/ match: 2) +;; +;; (expect:ignore in "Blah2" < 99 "FALSE ERROR" #/ERROR/) +;; (expect:ignore in "Body" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +;; (expect:warning in "Body" = 0 "Any warning" #/WARNING/) +;; (expect:error in "Body" = 0 "ERROR BLAH" (list #/ERROR/ #/error/)) ;; but disallow any other errors +;; +;; ;(expect in "Init" < 1 "Junk" #/This is bogus/) ADDED tests/release/tests/testpatt/testconfig Index: tests/release/tests/testpatt/testconfig ================================================================== --- /dev/null +++ tests/release/tests/testpatt/testconfig @@ -0,0 +1,12 @@ +[ezsteps] +clean $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -remove-runs -testpatt % -target ubuntu/nfs/none -runname release_testpatt +cleanres $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs release_testpatt -target ubuntu/nfs/none + +runitems $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -run -testpatt runfirst/%2 -target ubuntu/nfs/none -runname release_testpatt +results $MTRUNNER $MTTESTDIR/fullrun $MTPATH megatest -list-runs release_testpatt -target ubuntu/nfs/none + +[requirements] +# waiton #{getenv ALL_TOPLEVEL_TESTS} + +# This is a "toplevel" test, it does not require waitons to be non-FAIL to run +# mode toplevel Index: tests/rununittest.sh ================================================================== --- tests/rununittest.sh +++ tests/rununittest.sh @@ -1,13 +1,10 @@ #!/bin/bash # Usage: rununittest.sh testname debuglevel # -# Ensure all is made -(cd ..;make && make install) - # put megatest on path from correct location mtbindir=$(readlink -f ../bin) export PATH="${mtbindir}:$PATH" ADDED tests/unit.logpro Index: tests/unit.logpro ================================================================== --- /dev/null +++ tests/unit.logpro @@ -0,0 +1,8 @@ +;; You should have at least one expect:required. This ensures that your process ran +(expect:required in "LogFileBody" > 0 "At least one PASS" #/\[.{0,4}PASS.{0,4}\]/) + +;; You may need ignores to suppress false error or warning hits from the later expects +;; NOTE: Order is important here! +(expect:ignore in "LogFileBody" < 99 "Ignore the word error in comments" #/^\/\/.*error/) +(expect:warning in "LogFileBody" = 0 "Any warning" #/warn/) +(expect:error in "LogFileBody" = 0 "Any error" (list #/error/i #/\[.{0,4}FAIL.{0,4}\]/)) ;; but disallow any other errors Index: tests/unittests/misc.scm ================================================================== --- tests/unittests/misc.scm +++ tests/unittests/misc.scm @@ -41,5 +41,8 @@ (test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname GLOB '' AND item_path LIKE 'b%')" (tests:match->sqlqry "a/b,a%,/b%")) (test #f "(testname GLOB 'a' AND item_path GLOB 'b') OR (testname LIKE 'a%' AND item_path LIKE '%') OR (testname LIKE '%' AND item_path LIKE 'b%')" (tests:match->sqlqry "a/b,a%,%/b%")) + +(exit) + Index: tests/unittests/runs.scm ================================================================== --- tests/unittests/runs.scm +++ tests/unittests/runs.scm @@ -1,24 +1,23 @@ -(define keys (db:get-keys *db*)) +(define keys (rmt:get-keys)) -(test "get all legal tests" (list "test1" "test2") (sort (get-all-legal-tests) string<=?)) +(test "get all legal tests" (list "test1" "test2") (sort (hash-table-keys (tests:get-all)) string<=?)) (test "register-run" #t (number? - (db:register-run *db* + (rmt:register-run '(("SYSTEM" "key1")("RELEASE" "key2")) "myrun" "new" "n/a" "bob"))) -(test #f #t (cdb:tests-register-test *runremote* 1 "nada" "")) -(test #f 1 (cdb:remote-run db:get-test-id #f 1 "nada" "")) -(test #f "NOT_STARTED" (vector-ref (open-run-close db:get-test-info #f 1 "nada" "") 3)) -(test #f "NOT_STARTED" (vector-ref (cdb:get-test-info *runremote* 1 "nada" "") 3)) +(test #f #t (rmt:register-test 1 "nada" "")) +(test #f 30001 (rmt:get-test-id 1 "nada" "")) +(test #f "NOT_STARTED" (vector-ref (rmt:get-test-info-by-id 1 30001) 3)) ;; "nada" "") 3)) (test #f "FOO LIKE 'abc%def'" (db:patt->like "FOO" "abc%def")) -(test #f "key2" (vector-ref (car (vector-ref (runs:get-runs-by-patt *db* '("SYSTEM" "RELEASE") "%" "key1/key2") 1)) 1)) +(test #f "key2" (vector-ref (car (vector-ref (mt:get-runs-by-patt '("SYSTEM" "RELEASE") "%" "key1/key2") 1)) 1)) (test #f "SYSTEM,RELEASE,id,runname,state,status,owner,event_time" (car (runs:get-std-run-fields keys '("id" "runname" "state" "status" "owner" "event_time")))) (test #f #t (runs:operate-on 'print "%" "%" "%")) ;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada" @@ -48,16 +47,18 @@ ;; force keepgoing ; (hash-table-set! args:arg-hash "-keepgoing" #t) (hash-table-set! args:arg-hash "-itempatt" "%") (hash-table-set! args:arg-hash "-testpatt" "%") -(hash-table-set! args:arg-hash "-target" "ubuntu/r1.2") -(test "Setup for a run" #t (begin (setup-for-run) #t)) +(hash-table-set! args:arg-hash "-target" "ubuntu/r1.2") ;; SYSTEM/RELEASE +(hash-table-set! args:arg-hash "-runname" "testrun") +(test "Setup for a run" #t (begin (launch:setup-for-run) #t)) (define *tdb* #f) (define keyvals #f) (test "target->keyval" #t (let ((kv (keys:target->keyval keys (args:get-arg "-target")))) + (print "keyvals=" kv ", keys=" keys) (set! keyvals kv)(list? keyvals))) (define testdbpath (conc "/tmp/" (getenv "USER") "/megatest_testing")) (system (conc "rm -f " testdbpath "/testdat.db;mkdir -p " testdbpath)) @@ -67,38 +68,37 @@ (sqlite3#database? db))) (sqlite3#finalize! *tdb*) ;; (test "Remove the rollup run" #t (begin (remove-runs) #t)) (define tconfig #f) -(test "get a testconfig" #t (let ((tconf (tests:get-testconfig "test1" 'return-procs))) +(test "get a testconfig" #t (let ((tconf (tests:get-testconfig "test1" (tests:get-all) 'return-procs ))) (set! tconfig tconf) (hash-table? tconf))) -(db:clean-all-caches) (test "set-megatest-env-vars" "ubuntu" (begin - (set-megatest-env-vars 1 inkeys: keys) + (runs:set-megatest-env-vars 1 inkeys: keys) (get-environment-variable "SYSTEM"))) (test "setup-env-defaults" "see this variable" (begin - (setup-env-defaults "runconfigs.config" 1 *already-seen-runconfig-info* keys keyvals "pre-launch-env-vars") + (setup-env-defaults "runconfigs.config" 1 *already-seen-runconfig-info* keyvals environ-patt: "pre-launch-env-vars") (get-environment-variable "ALLTESTS"))) (test #f "ubuntu" (car (keys:target-set-args keys (args:get-arg "-target") args:arg-hash))) (define rinfo #f) -(test "get-run-info" #f (vector? (vector-ref (let ((rinf (cdb:remote-run db:get-run-info #f 1))) +(test "get-run-info" #f (vector? (vector-ref (let ((rinf (rmt:get-run-info 1))) (set! rinfo rinf) rinf) 0))) -(test "get-key-vals" "key1" (car (cdb:remote-run db:get-key-vals #f 1))) +;; (test "get-key-vals" "key1" (car (db:get-key-vals *dbstruct* 1))) (test "tests:sort-by" '() (tests:sort-by-priority-and-waiton (make-hash-table))) (test "update-test_meta" "test1" (begin (runs:update-test_meta "test1" tconfig) - (let ((dat (cdb:remote-run db:testmeta-get-record #f "test1"))) + (let ((dat (rmt:testmeta-get-record "test1"))) (vector-ref dat 1)))) (define test-path "tests/test1") (define disk-path #f) (test "get-best-disk" #t (string? (file-exists? (let ((d (get-best-disk *configdat*))) @@ -105,62 +105,117 @@ (set! disk-path d) d)))) (test "create-work-area" #t (symbolic-link? (car (create-work-area 1 rinfo keyvals 1 test-path disk-path "test1" '())))) (test #f "" (item-list->path '())) -(test "launch-test" #t (string? (file-exists? (launch-test 1 1 rinfo keyvals "run1" tconfig "test1" test-path '() (make-hash-table))))) - - -(test "Run a test" #t (general-run-call - "-runtests" - "run a test" - (lambda (target runname keys keyvallst) - (let ((test-patts "test%")) - ;; (runs:run-tests target runname test-patts user (make-hash-table)) - ;; (run:test run-id run-info key-vals runname test-record flags parent-test) - ;; (set! *verbosity* 22) ;; (list 0 1 2)) - (run:test 1 ;; run-id - #f ;; run-info is yet only a dream - keyvallst ;; (keys:target->keyval keys target) - "run1" ;; runname - (vector ;; test_records.scm tests:testqueue - "test1" ;; testname - tconfig ;; testconfig - '() ;; waitons - 0 ;; priority - #f ;; items - #f ;; itemsdat - "" ;; itempath - ) - args:arg-hash ;; flags (e.g. -itemspatt) - #f) - ;; (set! *verbosity* 0) - )))) - - - - - -(test "server stop" #f (let ((hostname (car *runremote*)) - (port (cadr *runremote*))) - (tasks:kill-server #t hostname port server-pid 'http) - (open-run-close tasks:get-best-server tasks:open-db))) +;;====================================================================== +;; Create a test with multiple items and verify that rollup logic works +;;====================================================================== + +(rmt:register-test 1 "rollup" "") ;; toplevel test +(for-each + (lambda (itempath) + (rmt:register-test 1 "rollup" itempath) + (let ((test-id (rmt:get-test-id 1 "rollup" itempath)) + (comment (conc "This is a comment for itempath " itempath))) + ;; (rmt:test-set-state-status-by-id run-id test-id "COMPLETED" "PASS" comment) + (tests:test-set-status! 1 test-id "COMPLETED" "PASS" comment #f))) ;; #!key (work-area #f)) + '("item/1" "item/2" "item/3" "item/4" "item/5")) + +(test #f #t (number? (rmt:get-test-id 1 "rollup" "item/4"))) + +(define (get-state-status run-id testname itempath) + (let ((tdat (rmt:get-test-info-by-id 1 (rmt:get-test-id run-id testname itempath)))) + (list (db:test-get-state tdat) + (db:test-get-status tdat)))) + +(test "Rollup PASS" '("COMPLETED" "PASS") (get-state-status 1 "rollup" "")) +(let ((test-id (rmt:get-test-id 1 "rollup" "item/4")) + (top-id (rmt:get-test-id 1 "rollup" ""))) + (for-each + (lambda (state status rup-state rup-status) + ;; reset to COMPLETED/PASS + (tests:test-set-status! 1 test-id "COMPLETED" "PASS" #f #f) + (test "Top reset to COMPLETED/PASS" '("COMPLETED" "PASS")(get-state-status 1 "rollup" "")) + (tests:test-set-status! 1 test-id state status #f #f) + (test (conc "Item set to " state "/" status) + (list state status) + (get-state-status 1 "rollup" "item/4")) + (test (conc "Rollup of " state "/" status) + (list rup-state rup-status) + (get-state-status 1 "rollup" ""))) + '("COMPLETED" "COMPLETED" "INCOMPLETE" "INCOMPLETE" "RUNNING" "RUNNING" "COMPLETED" "COMPLETED") + '("ABORT" "FAIL" "PASS" "FAIL" "PASS" "FAIL" "BLAH" "AUTO") + '("COMPLETED" "COMPLETED" "COMPLETED" "COMPLETED" "RUNNING" "RUNNING" "COMPLETED" "COMPLETED") + '("ABORT" "FAIL" "FAIL" "FAIL" "PASS" "FAIL" "ABORT" "AUTO"))) + + +(test "launch-test" #t + (string? + (file-exists? + ;; (launch-test test-id run-id run-info keyvals runname test-conf test-name test-path itemdat params) + (launch-test 30001 1 rinfo keyvals "run1" tconfig "test1" test-path '() (make-hash-table))))) + + + (exit 1) + + + + +;; (test "Run a test" #t (general-run-call +;; "-runtests" +;; "run a test" +;; (lambda (target runname keys keyvallst) +;; (let ((test-patts "test%")) +;; ;; (runs:run-tests target runname test-patts user (make-hash-table)) +;; ;; (run:test run-id run-info key-vals runname test-record flags parent-test) +;; ;; (set! *verbosity* 22) ;; (list 0 1 2)) +;; (run:test 1 ;; run-id +;; #f ;; run-info is yet only a dream +;; keyvallst ;; (keys:target->keyval keys target) +;; "run1" ;; runname +;; (vector ;; test_records.scm tests:testqueue +;; "test1" ;; testname +;; tconfig ;; testconfig +;; (make-hash-table) ;; flags +;; #f ;; parent test +;; (tests:get-all) ;; test registry +;; 0 ;; priority +;; #f ;; items +;; #f ;; itemsdat +;; "" ;; itempath +;; ) +;; args:arg-hash ;; flags (e.g. -itemspatt) +;; #f) +;; ;; (set! *verbosity* 0) +;; )))) +;; +;; +;; +;; +;; +;; (test "server stop" #f (let ((hostname (car *runremote*)) +;; (port (cadr *runremote*))) +;; (tasks:kill-server #t hostname port server-pid 'http) +;; (open-run-close tasks:get-best-server tasks:open-db))) + ;; (test "cache is coherent" #t (let ((cached-info (db:get-test-info-cached-by-id db 2)) ;; (non-cached (db:get-test-info-not-cached-by-id db 2))) ;; (print "\nCached: " cached-info) ;; (print "Noncached: " non-cached) ;; (equal? cached-info non-cached))) (change-directory test-work-dir) +(test #f #t (> (length (mt:get-tests-for-run 1 "test1" '() '())) 0)) (test "Add a step" #t (begin - (db:teststep-set-status! db 2 "step1" "start" 0 "This is a comment" "mylogfile.html") + (rmt:teststep-set-status! 1 30002 "step1" "start" 0 "This is a comment" "mylogfile.html") (sleep 2) - (db:teststep-set-status! db 2 "step1" "end" "pass" "This is a different comment" "finallogfile.html") - (set! test-id (db:test-get-id (car (cdb:remote-run db:get-tests-for-run #f 1 "test1" '() '())))) + (rmt:teststep-set-status! 1 30002 "step1" "end" "pass" "This is a different comment" "finallogfile.html") + (set! test-id (db:test-get-id (car (mt:get-tests-for-run 1 "test1" '() '())))) (number? test-id))) (test "Get rundir" #t (let ((rundir (cdb:remote-run db:test-get-rundir-from-test-id #f test-id))) (print "Rundir " rundir) (system (conc "mkdir -p " rundir)) Index: tests/unittests/tests.scm ================================================================== --- tests/unittests/tests.scm +++ tests/unittests/tests.scm @@ -0,0 +1,13 @@ +;;====================================================================== +;; itemwait, itemmatch + +(db:compare-itempaths ref-item-path item-path itemmap) + +;; prereqs-not-met + +(rmt:get-prereqs-not-met run-id waitons item-path mode: testmode itemmap: itemmap)) + + (fails (runs:calc-fails prereqs-not-met)) + (prereq-fails (runs:calc-prereq-fail prereqs-not-met)) + (non-completed (runs:calc-not-completed prereqs-not-met)) + (runnables (runs:calc-runnable prereqs-not-met))) Index: utils/Makefile.installall ================================================================== --- utils/Makefile.installall +++ utils/Makefile.installall @@ -34,12 +34,13 @@ endif # Set this on the command line of your make call if needed: make PROXY=host.com:1234 PROXY= +# http://code.call-cc.org/dev-snapshots/2015/06/07/chicken-4.10.0rc1.tar.gz # Select version of chicken, sqlite3 etc -CHICKEN_VERSION=4.9.0.1 +CHICKEN_VERSION=4.10.0rc1 SQLITE3_VERSION=3080500 # http://www.sqlite.org/2014/sqlite-autoconf-3080500.tar.gz # Override IUPBRANCH to use other than trunk IUPBRANCH=iup-3.10.1 @@ -136,10 +137,13 @@ wget http://code.call-cc.org/dev-snapshots/2014/04/17/chicken-4.9.0rc1.tar.gz chicken-4.9.0.1.tar.gz : wget http://code.call-cc.org/releases/4.9.0/chicken-4.9.0.1.tar.gz +chicken-4.10.0rc1.tar.gz : + wget http://code.call-cc.org/dev-snapshots/2015/06/07/chicken-4.10.0rc1.tar.gz + # git clone git://code.call-cc.org/chicken-core # git clone http://code.call-cc.org/git/chicken-core.git $(CHICKEN_INSTALL) : chicken-core/chicken.scm $(PREFIX)/setup-chicken4x.sh $(PREFIX)/setup-chicken4x.csh cd chicken-core;make PLATFORM=linux PREFIX=$(PREFIX) ADDED utils/mtrunner Index: utils/mtrunner ================================================================== --- /dev/null +++ utils/mtrunner @@ -0,0 +1,14 @@ +#! /bin/bash + +# Run megatest from within megatest +# Usage: mtrunner testsuite_dir megatest_bin_dir command args .... + +for var in $(env | egrep "^MT_"|cut -d= -f1);do + unset ${var} +done +cd $1 +shift +export PATH="$1:$PATH" +shift + +"$@"