Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -253,13 +253,14 @@ ;; 'new2old 'killservers 'adj-target ;; 'old2new 'new2old - (if full + ;; (if full '(dejunk) - '())) + ;; '()) + ) (if (common:api-changed?) (common:set-last-run-version))) ;; Rotate logs, logic: ;; if > 500k and older than 1 week: Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -858,11 +858,19 @@ (sqlite3:execute maindb "CREATE TRIGGER IF NOT EXISTS update_run_stats_trigger AFTER UPDATE ON run_stats FOR EACH ROW BEGIN UPDATE run_stats SET last_update=(strftime('%s','now')) WHERE id=old.id; - END;")) + END;") + (sqlite3:execute maindb "CREATE TABLE IF NOT EXISTS test_rundat ( + id INTEGER PRIMARY KEY, + test_id INTEGER, + update_time TIMESTAMP, + cpuload INTEGER DEFAULT -1, + diskfree INTEGER DEFAULT -1, + diskusage INTGER DEFAULT -1, + run_duration INTEGER DEFAULT 0);")) (define (db:adj-target db) (let ((fields (configf:get-section *configdat* "fields")) (field-num 0)) ;; because we will be refreshing the keys table it is best to clear it here @@ -1678,10 +1686,14 @@ "DELETE FROM tests WHERE run_id NOT IN (SELECT DISTINCT id FROM runs);" ;; delete all runs that are state='deleted' "DELETE FROM runs WHERE state='deleted';" ;; delete empty runs "DELETE FROM runs WHERE id NOT IN (SELECT DISTINCT r.id FROM runs AS r INNER JOIN tests AS t ON t.run_id=r.id);" + ;; remove orphaned test_rundat entries + "DELETE FROM test_rundat where test_id NOT IN (SELECT id FROM tests);" + ;; + "DELETE FROM test_steps WHERE test_id NOT IN (SELECT id FROM tests);" )))) ;; (db:delay-if-busy dbdat) (sqlite3:with-transaction db (lambda () Index: minimt/Makefile ================================================================== --- minimt/Makefile +++ minimt/Makefile @@ -1,6 +1,12 @@ minimt : minimt.scm db.scm setup.scm direct.scm csc minimt.scm +run : minimt + export PATH="$(PWD)":$(PATH) ; minimt runrun foo/bar run1 + +runseq : clean run + sleep 5;tail -F runtest/*log + clean : rm -rf runtest/* Index: minimt/db.scm ================================================================== --- minimt/db.scm +++ minimt/db.scm @@ -54,11 +54,11 @@ (open-database fullname) (begin (print "FATAL: No existing db and no write access thus cannot create " fullname) ;; no db and no write access cannot proceed. (exit 1)))) (dbconn (make-dbconn-dat))) - (set-busy-handler! db (busy-timeout 30000)) ;; set a busy timeout + (set-busy-handler! db (busy-timeout 120000)) ;; set a busy timeout (exec (sql db "PRAGMA synchronous=0;")) (if (and init write-access (not already-exists)) (init db)) (dbconn-dat-dbh-set! dbconn db) (dbconn-dat-writeable-set! dbconn write-access) @@ -98,22 +98,33 @@ ;; get a test id (define (get-test-id dbconn run-id test-name) (first-column (query fetch (sql (get-db dbconn) "SELECT id FROM tests WHERE run_id=? AND test_name=?;") run-id test-name))) -;; get the data for given test-id -(define (test-get-record dbconn test-id) - (let* ((row (query fetch-row (sql (get-db dbconn) "SELECT id,run-id,test_name,state,status FROM tests WHERE test_id=?;") - test-id))) +(define-inline (test-row->test-dat row) (make-test-dat id: (list-ref row 0) run-id: (list-ref row 1) test-name: (list-ref row 2) state: (list-ref row 3) - status: (list-ref row 4)))) - + status: (list-ref row 4))) +;; get the data for given test-id +(define (test-get-record dbconn test-id) + (let* ((row (query fetch-row (sql (get-db dbconn) "SELECT id,run_id,test_name,state,status FROM tests WHERE test_id=?;") + test-id))) + (test-row->test-dat row))) + +;; get a bunch of tests data +(define (test-get-tests dbconn run-ids test-name-patt) + (let* ((rows (query fetch-rows + (sql (get-db dbconn) + (conc "SELECT id,run_id,test_name,state,status FROM tests WHERE test_name LIKE ? AND run_id IN (" + (string-intersperse (map conc run-ids) ",") ");")) + test-name-patt))) + (map test-row->test-dat rows))) + (define (test-set-state-status dbconn test-id new-state new-status) (exec (sql (get-db dbconn) "UPDATE tests SET state=?,status=?,end_time=? WHERE id=?;") new-state new-status (current-seconds) test-id)) ;; STEPS @@ -129,5 +140,34 @@ test-id step-name))) (define (step-set-state-status dbconn step-id new-state new-status) (exec (sql (get-db dbconn) "UPDATE steps SET state=?,status=? WHERE id=?;") new-state new-status step-id)) + +;;====================================================================== +;; Statistics gathering +;;====================================================================== + +(define *stats* (make-hash-table)) + +(define (update-stats key duration) + (let ((rec (or (hash-table-ref/default *stats* key #f) + (let ((new (vector 0 0 0))) + (hash-table-set! *stats* key new) + new)))) + (vector-set! rec 0 (+ (vector-ref rec 0) 1)) ;; num calls + (vector-set! rec 1 (+ (vector-ref rec 1) duration)) ;; total duration + (if (> duration (vector-ref rec 2) ) + (vector-set! rec 2 duration)))) + +(define (statwrap name proc) + (lambda params + (let ((start-time (current-milliseconds)) + (res (apply proc params))) + (update-stats name (- (current-milliseconds) start-time)) + res))) + +(define (print-stats statdat) + (hash-table-for-each + statdat + (lambda (key val) + (print key " count: " (vector-ref val 0) " avg: " (/ (vector-ref val 1)(vector-ref val 0)) " max: " (vector-ref val 2))))) Index: minimt/direct.scm ================================================================== --- minimt/direct.scm +++ minimt/direct.scm @@ -1,10 +1,11 @@ ;; direct API, call the db calls directly - -(define rmt:create-run create-run) -(define rmt:create-step create-step) -(define rmt:create-test create-test) -(define rmt:get-test-id get-test-id) -(define rmt:get-run-id get-run-id) -(define rmt:open-create-db open-create-db) -(define rmt:step-set-state-status step-set-state-status) -(define rmt:test-set-state-status test-set-state-status) +(define rmt:create-run (statwrap 'create-run create-run)) +(define rmt:create-step (statwrap 'create-step create-step)) +(define rmt:create-test (statwrap 'create-test create-test)) +(define rmt:get-test-id (statwrap 'get-test-id get-test-id)) +(define rmt:get-run-id (statwrap 'get-run-id get-run-id)) +(define rmt:open-create-db (statwrap 'open open-create-db)) +(define rmt:step-set-state-status (statwrap 'step-set-state-status step-set-state-status)) +(define rmt:test-set-state-status (statwrap 'test-set-state-status test-set-state-status)) +(define rmt:test-get-tests (statwrap 'test-get-tests test-get-tests)) + Index: minimt/minimt.scm ================================================================== --- minimt/minimt.scm +++ minimt/minimt.scm @@ -28,12 +28,16 @@ (thread-sleep! *stepdelay*) (rmt:step-set-state-status dbconn step-id "END" 0) (print" STEP: " step-name " done."))) (if (< step-num *numsteps*) (loop (+ step-num 1)))) + ;; we will do a large but bogus read to simulate the logic in Megatest + (rmt:test-get-tests dbconn `(,run-id) "%") (rmt:test-set-state-status dbconn test-id "COMPLETED" (if (> (random 10) 2) "PASS" "FAIL")) (print "TEST: " test-name " done.") + (print "Stats:") + (print-stats *stats*) test-id)) ;; RUN A RUN (define (run-run dbconn target run-name num-tests) (rmt:create-run dbconn target run-name) @@ -50,10 +54,11 @@ "Usage: minimt [options]" " runtest run-id testname runrun target runname") (let ((cmd (car args)) (dbconn (rmt:open-create-db *homepath* "mt.db" init-db))) + (thread-sleep! 0.5) ;; be sure the db is written out to disk? Should really not be needed. (change-directory *homepath*) (case (string->symbol cmd) ((runtest) (let ((run-id (string->number (cadr args))) (test-name (caddr args))) @@ -72,8 +77,10 @@ (thread-sleep! *rundelay*) (system (conc "NBFAKE_LOG=run-" target "-" run-num ".log nbfake minimt runrun " target " run-" run-num)) (if (< run-num *numruns*) (loop (+ run-num 1))))) *targets*)) + ((server) + (start-server dbconn)) (else (print "Command: " cmd " not recognised. Run without params to see help."))) (close-database (dbconn-dat-dbh dbconn))))) Index: minimt/setup.scm ================================================================== --- minimt/setup.scm +++ minimt/setup.scm @@ -1,10 +1,10 @@ (define *remotehost* "orion") (define *homehost* "zeus") (define *homepath* "/nfs/phoebe/disk1/home/mfs_matt/data/megatest/minimt/runtest") -(define *numsteps* 100) -(define *numtests* 50) +(define *numsteps* 20) +(define *numtests* 20) (define *numruns* 5) (define *targets* '("targ1")) (define *testdelay* 0) (define *rundelay* 0) (define *launchdelay* 0)