Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -648,29 +648,26 @@ (let loop ((start-time (current-time))) (thread-sleep! 0.5) ;; move save time around to minimize regular collisions? (db:write-cached-data db) (loop start-time))) -(define (db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree) - (if (not item-path) - (begin (debug:print 0 "WARNING: ITEMPATH not set.") - (set! item-path ""))) +(define (db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree) (mutex-lock! *incoming-mutex*) (set! *incoming-data* (cons (vector 'meta-info (current-seconds) (list cpuload diskfree minutes - run-id - test-name - item-path)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) + test-id)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) *incoming-data*)) (mutex-unlock! *incoming-mutex*) - (if (not *cache-on*)(db:write-cached-data db))) + (if *cache-on* + (debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write as part of test-update-meta-info") + (db:write-cached-data db))) (define (db:write-cached-data db) - (let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE run_id=? AND testname=? AND item_path=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');")) + (let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE id=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');")) (step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);")) ;; strftime('%s','now')#f) (data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref b 1)))))) (if (> (length data) 0) (debug:print 4 "Writing cached data " data)) (mutex-lock! *incoming-mutex*) @@ -1141,18 +1138,17 @@ (port (vector-ref *runremote* 1))) ((rpc:procedure 'rdb:teststep-set-status! host port) test-id teststep-name state-in status-in item-path comment logfile)) (db:teststep-set-status! db test-id teststep-name state-in status-in item-path comment logfile)))) -(define (rdb:test-update-meta-info db run-id test-name itemdat minutes cpuload diskfree tmpfree) - (let ((item-path (item-list->path itemdat))) - (if *runremote* - (let ((host (vector-ref *runremote* 0)) - (port (vector-ref *runremote* 1))) - ((rpc:procedure 'rdb:test-update-meta-info host port) - run-id test-name item-path minutes cpuload diskfree tmpfree)) - (db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree)))) +(define (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree) + (if *runremote* + (let ((host (vector-ref *runremote* 0)) + (port (vector-ref *runremote* 1))) + ((rpc:procedure 'rdb:test-update-meta-info host port) + test-id minutes cpuload diskfree tmpfree)) + (db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree))) (define (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-path status state) (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -64,11 +64,11 @@ (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo)) (fullrunscript (if runscript (conc testpath "/" runscript) #f)) (db #f) (rollup-status 0)) - (debug:print 2 "Exectuing " test-name " on " (get-host-name)) + (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) (change-directory testpath) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) (let ((varpairs (string-split set-vars ","))) @@ -94,11 +94,11 @@ (exit 1))) ;; now can find our db (set! db (open-db)) (if (not (args:get-arg "-server")) (server:client-setup db)) - (set! *cache-on* #t) + ;; (set! *cache-on* #t) (set-megatest-env-vars db run-id) ;; these may be needed by the launching process (change-directory work-area) (set-run-config-vars db run-id) ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) @@ -260,11 +260,11 @@ (if (not (args:get-arg "-server")) (server:client-setup db)) (if (not cpuload) (begin (debug:print 0 "WARNING: CPULOAD not found.") (set! cpuload "n/a"))) (if (not diskfree) (begin (debug:print 0 "WARNING: DISKFREE not found.") (set! diskfree "n/a"))) (set! kill-job? (test-get-kill-request db run-id test-name itemdat)) - (rdb:test-update-meta-info db run-id test-name itemdat minutes cpuload diskfree tmpfree) + (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree) (if kill-job? (begin (mutex-lock! m) (let* ((pid (vector-ref exit-info 0))) (if (number? pid) @@ -436,39 +436,39 @@ ;; - could be netbatch ;; (launch-test db (cadr status) test-conf)) (define (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat params) (change-directory *toppath*) (let* ((useshell (config-lookup *configdat* "jobtools" "useshell")) - (launcher (config-lookup *configdat* "jobtools" "launcher")) - (runscript (config-lookup test-conf "setup" "runscript")) - (ezsteps (> (length (hash-table-ref/default test-conf "ezsteps" '())) 0)) ;; don't send all the steps, could be big - (diskspace (config-lookup test-conf "requirements" "diskspace")) - (memory (config-lookup test-conf "requirements" "memory")) - (hosts (config-lookup *configdat* "jobtools" "workhosts")) - (remote-megatest (config-lookup *configdat* "setup" "executable")) - ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to - ;; allow running from dashboard. Extract the path - ;; from the called megatest and convert dashboard - ;; or dboard to megatest - (local-megatest (let* ((lm (car (argv))) - (dir (pathname-directory lm)) - (exe (pathname-strip-directory lm))) - (conc (if dir (conc dir "/") "") - (case (string->symbol exe) - ((dboard) "megatest") - ((dashboard) "megatest") - (else exe))))) - (test-sig (conc test-name ":" (item-list->path itemdat))) ;; test-path is the full path including the item-path - (work-area #f) - (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all - (diskpath #f) - (cmdparms #f) - (fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x)))) - (mt-bindir-path #f) - (item-path (item-list->path itemdat)) - (testinfo (rdb:get-test-info db run-id test-name item-path)) - (test-id (db:test-get-id testinfo))) + (launcher (config-lookup *configdat* "jobtools" "launcher")) + (runscript (config-lookup test-conf "setup" "runscript")) + (ezsteps (> (length (hash-table-ref/default test-conf "ezsteps" '())) 0)) ;; don't send all the steps, could be big + (diskspace (config-lookup test-conf "requirements" "diskspace")) + (memory (config-lookup test-conf "requirements" "memory")) + (hosts (config-lookup *configdat* "jobtools" "workhosts")) + (remote-megatest (config-lookup *configdat* "setup" "executable")) + ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to + ;; allow running from dashboard. Extract the path + ;; from the called megatest and convert dashboard + ;; or dboard to megatest + (local-megatest (let* ((lm (car (argv))) + (dir (pathname-directory lm)) + (exe (pathname-strip-directory lm))) + (conc (if dir (conc dir "/") "") + (case (string->symbol exe) + ((dboard) "megatest") + ((dashboard) "megatest") + (else exe))))) + (test-sig (conc test-name ":" (item-list->path itemdat))) ;; test-path is the full path including the item-path + (work-area #f) + (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all + (diskpath #f) + (cmdparms #f) + (fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x)))) + (mt-bindir-path #f) + (item-path (item-list->path itemdat)) + (testinfo (rdb:get-test-info db run-id test-name item-path)) + (test-id (db:test-get-id testinfo))) (if hosts (set! hosts (string-split hosts))) ;; set the megatest to be called on the remote host (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest")) (set! mt-bindir-path (pathname-directory remote-megatest)) (if launcher (set! launcher (string-split launcher))) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -627,11 +627,12 @@ (server:client-setup db)) (if (args:get-arg "-load-test-data") ;; has sub commands that are rdb: (db:load-test-data db test-id)) (if (args:get-arg "-setlog") - (rtests:test-set-log! db test-id (args:get-arg "-setlog"))) + (let ((logfname (args:get-arg "-setlog"))) + (rdb:test-set-log! db test-id logfname))) (if (args:get-arg "-set-toplog") (rtests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog"))) (if (args:get-arg "-summarize-items") (rdb:tests:summarize-items db run-id test-name #t)) ;; do force here (if (args:get-arg "-runstep") Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -400,7 +400,6 @@ (if *runremote* (let ((host (vector-ref *runremote* 0)) (port (vector-ref *runremote* 1))) ((rpc:procedure 'rtests:test-set-toplog! host port) run-id test-name logf)) (test-set-toplog! db run-id test-name logf))) - Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -2,22 +2,24 @@ BINPATH=$(shell realpath ../bin) MEGATEST=$(BINPATH)/megatest PATH := $(BINPATH):$(PATH) RUNNAME := $(shell date +w%V.%u.%H) -IPADDR :="-" +IPADDR := "-" +# Set SERVER to "-server $(IPADDR)" +SERVER := "" runall : test1 test2 test1 : cleanprep - $(MEGATEST) -runtests ez_pass -target ubuntu/nfs/none :runname $(RUNNAME)_a -server $(IPADDR) + $(MEGATEST) -runtests ez_pass -target ubuntu/nfs/none :runname $(RUNNAME)_a $(SERVER) test2 : cleanprep - $(MEGATEST) -runtests runfirst -target ubuntu/nfs/none :runname $(RUNNAME)_b -server $(IPADDR) -debug 10 + $(MEGATEST) -runtests runfirst -target ubuntu/nfs/none :runname $(RUNNAME)_b $(SERVER) -debug 10 test3 : cleanprep - $(MEGATEST) -runall -target ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v -server $(IPADDR) + $(MEGATEST) -runall -target ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER) cleanprep : ../*.scm sqlite3 megatest.db "delete from metadat where var='SERVER';" mkdir -p /tmp/mt_runs /tmp/mt_links cd ..;make Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -20,12 +20,12 @@ ## exit with (exit) ## get a shell with (system "bash") # launcher xterm -e csi -- [validvalues] -state start end completed 0 -status pass fail n/a 0 1 +state start end +status pass fail n/a 0 1 running # These are set before all tests, override them # in the testconfig [pre-launch-env-overrides] section [env-override] SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs Index: utils/mt_ezstep ================================================================== --- utils/mt_ezstep +++ utils/mt_ezstep @@ -1,18 +1,26 @@ #!/bin/bash +usage="mt_ezstep stepname prevstepname command [args ...]" + if [ "$MT_CMDINFO" == "" ];then echo "ERROR: $0 should be run within a megatest test environment" + echo "Usage: $usage" exit fi # Purpose: This is for the [ezsteps] secton in your testconfig file. # DO NOT USE IN YOUR SCRIPTS! # # Call like this: # mt_ezstep stepname prevstepname command .... # +if [ "x$1" == "x" ];then + echo "Usage: $usage" + exit +fi + stepname=$1;shift prevstepname=$1;shift command=$*