Index: Makefile ================================================================== --- Makefile +++ Makefile @@ -20,11 +20,11 @@ dboard : $(OFILES) $(GOFILES) csc $(OFILES) $(GOFILES) -o dboard # Special dependencies for the includes -db.o launch.o runs.o dashboard-tests.o dashboard.o megatest.o : db_records.scm +db.o launch.o runs.o dashboard-tests.o dashboard-guimonitor.o monitor.o dashboard.o megatest.o : db_records.scm runs.o dashboard.o dashboard-tests.o : run_records.scm keys.o db.o runs.o launch.o megatest.o : key_records.scm tasks.o dashboard-tasks.o : task_records.scm $(OFILES) $(GOFILES) : common_records.scm Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -282,11 +282,11 @@ res))) (define db:get-keys db-get-keys) (define (db:get-value-by-header row header field) - (debug:print 0 "db:get-value-by-header row: " row " header: " header " field: " field) + ;; (debug:print 2 "db:get-value-by-header row: " row " header: " header " field: " field) (if (null? header) #f (let loop ((hed (car header)) (tal (cdr header)) (n 0)) (if (equal? hed field) @@ -365,11 +365,11 @@ (remfields (list "id" "runname" "state" "status" "owner" "event_time")) (header (append (map key:get-fieldname keys) remfields)) (keystr (conc (keys->keystr keys) "," (string-intersperse remfields ",")))) - (debug:print 0 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr) + ;; (debug:print 0 "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr) (sqlite3:for-each-row (lambda (a . x) (set! res (apply vector a x))) db (conc "SELECT " keystr " FROM runs WHERE id=?;") Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -220,18 +220,18 @@ (db:test-data-rollup db test-id)) ;; add metadata (need to do this way to avoid SQL injection issues) ;; :first_err - (let ((val (hash-table-ref/default otherdat ":first_err" #f))) - (if val - (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) - - ;; :first_warn - (let ((val (hash-table-ref/default otherdat ":first_warn" #f))) - (if val - (sqlite3:execute db "UPDATE tests SET first_warn=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) + ;; (let ((val (hash-table-ref/default otherdat ":first_err" #f))) + ;; (if val + ;; (sqlite3:execute db "UPDATE tests SET first_err=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) + ;; + ;; ;; :first_warn + ;; (let ((val (hash-table-ref/default otherdat ":first_warn" #f))) + ;; (if val + ;; (sqlite3:execute db "UPDATE tests SET first_warn=? WHERE run_id=? AND testname=? AND item_path=?;" val run-id test-name item-path))) (let ((category (hash-table-ref/default otherdat ":category" "")) (variable (hash-table-ref/default otherdat ":variable" "")) (value (hash-table-ref/default otherdat ":value" #f)) (expected (hash-table-ref/default otherdat ":expected" #f)) @@ -638,11 +638,11 @@ (parent-test (and (not (null? items))(equal? item-path ""))) (single-test (and (null? items) (equal? item-path ""))) (item-test (not (equal? item-path ""))) (item-patt (args:get-arg "-itempatt")) (patt-match (if item-patt - (string-match (glob->regexp + (string-search (glob->regexp (string-translate item-patt "%" "*")) item-path) #t))) (debug:print 3 "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running) (if (and patt-match (runs:can-run-more-tests db)) @@ -944,16 +944,17 @@ ;; look through all the item-patts if defined, format is patt1,patt2,patt3 ... wildcard is % (item-matches (if item-patts (let ((res #f)) (for-each (lambda (patt) - (if (string-match (glob->regexp - (string-translate patt "%" "*")) - item-path) + (if (string-search (glob->regexp + (string-translate patt "%" "*")) + item-path) (set! res #t))) - (string-split item-patts ","))) - #t))) + (string-split item-patts ",")) + res) + #t))) (debug:print 3 "max-concurrent-jobs: " max-concurrent-jobs ", num-running: " num-running) (if (and item-matches (runs:can-run-more-tests db)) (begin (let loop2 ((ts (db:get-test-info db run-id test-name item-path)) ;; #f) (ct 0)) @@ -1246,12 +1247,12 @@ (test-steps (db:get-steps-for-test db (db:test-get-id testdat))) (new-test-record #f)) ;; replace these with insert ... select (apply sqlite3:execute db - (conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,first_err,first_warn) " - "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?);") + (conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment) " + "VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?);") new-run-id (cddr (vector->list testdat))) (set! new-testdat (car (db-get-tests-for-run db new-run-id testname item-path '() '()))) (hash-table-set! curr-tests-hash full-name new-testdat) ;; this could be confusing, which record should go into the lookup table? ;; Now duplicate the test steps (debug:print 4 "Copying records in test_steps from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat)) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -90,17 +90,17 @@ ;; execution time is updated with every snag, wait 10 secs before doing anything with the queue (sqlite3:for-each-row (lambda (id . rem) (set! res (apply vector id rem))) db - "SELECT id,action,owner,state,target,name,test,item,creation_time,execution_time + "SELECT id,action,owner,state,target,name,test,item,creation_time,execution_time FROM tasks_queue WHERE state='new' OR - (state='waiting' AND execution_time+10 > strftime('%s','now')) OR + (state='waiting' AND (strftime('%s','now')-execution_time) > 10) OR state='reset' - ORDER BY state ASC LIMIT 1;") + ORDER BY execution_time ASC LIMIT 1;") (if res ;; yep, have work to be done (begin (sqlite3:execute db "UPDATE tasks_queue SET state='inprogress',execution_time=strftime('%s','now') WHERE id=?;" (tasks:task-get-id res)) res) @@ -154,10 +154,11 @@ (loop (+ count 1) next-touch))))))) (define (tasks:process-queue db megatestdbpath) (let* ((task (tasks:snag-a-task db)) (action (if task (tasks:task-get-action task) #f))) + (print "tasks:process-queue task: " task) (if action (case (string->symbol action) ((run) (tasks:start-run db task)) ((remove) (tasks:remove-runs db task)) ((lock) (tasks:lock-runs db task)) @@ -232,18 +233,17 @@ (sqlite3:execute db "UPDATE tasks_queue SET state=? WHERE id=?;" state task-id)) (define (tasks:start-run db task) - ;; Starting run #(3 run matt reset ubuntu/afs/tmp ww44 % % 1319368208.0 1319386680.0) - ;; Starting run #(5 run matt reset centos/nfs/nada ww42 all all 1319371306.0 1319386801.0) - (print "Starting run " task) - ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY - (runs:run-tests db - (tasks:task-get-target task) - (tasks:task-get-name task) - (tasks:task-get-test task) - (tasks:task-get-item task) - (tasks:task-get-owner task) - (make-hash-table)) - (tasks:set-state db (tasks:task-get-id task) "waiting") - ) + (let ((flags (make-hash-table))) + (hash-table-set! flags "-rerun" "NOT_STARTED") + (print "Starting run " task) + ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY + (runs:run-tests db + (tasks:task-get-target task) + (tasks:task-get-name task) + (tasks:task-get-test task) + (tasks:task-get-item task) + (tasks:task-get-owner task) + flags) + (tasks:set-state db (tasks:task-get-id task) "waiting"))) Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -13,12 +13,12 @@ cd ../;make test make runall dashboard : cd ../;make dboard - ../dboard & + $(BINPATH)/dboard & remove : - (cd ../;make);../megatest -remove-runs :runname $(RUN) -testpatt % -itempatt % :sysname % :fsname % :datapath % + (cd ../;make);$(MEGATEST) -remove-runs :runname $(RUN) -testpatt % -itempatt % :sysname % :fsname % :datapath % runforever : - while(ls); do runname=`date +%F-%R:%S`;/home/matt/data/megatest/megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;/home/matt/data/megatest/megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;/home/matt/data/megatest/megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;done + while(ls); do runname=`date +%F-%R:%S`;$(MEGATEST) -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;/home/matt/data/megatest/megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;/home/matt/data/megatest/megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname $$runname;done Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -11,20 +11,20 @@ [jobtools] # useshell yes # ## launcher launches jobs, the job is managed on the target host ## by megatest, comment out launcher to run local # workhosts localhost hermes -# launcher nbfake +launcher nbfake # launcher nodanggood ## use "xterm -e csi -- " as a launcher to examine the launch environment. ## exit with (exit) ## get a shell with (system "bash") # launcher xterm -e csi -- [validvalues] -state start end completed +state start end completed 0 status pass fail n/a 0 1 # These are set before all tests, override them # in the testconfig [pre-launch-env-overrides] section [env-override]