Index: common.scm ================================================================== --- common.scm +++ common.scm @@ -33,10 +33,11 @@ (define *configinfo* #f) (define *configdat* #f) (define *toppath* #f) (define *already-seen-runconfig-info* #f) (define *waiting-queue* (make-hash-table)) +(define *test-meta-updated* (make-hash-table)) (define *globalexitstatus* 0) ;; attempt to work around possible thread issues (define *passnum* 0) ;; when running track calls to run-tests or similar (define *verbosity* 1) (define *rpc:listener* #f) ;; if set up for server communication this will hold the tcp port (define *runremote* #f) ;; if set up for server communication this will hold Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -213,11 +213,11 @@ tol REAL, units TEXT, comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', CONSTRAINT test_data UNIQUE (test_id,category,variable));") - (print "WARNING: Table test_data and test_meta where recreated. Please do megatest -update-meta") + (print "WARNING: Table test_data and test_meta were recreated. Please do megatest -update-meta") (patch-db)) ((< mver 1.27) (db:set-var db "MEGATEST_VERSION" 1.27) (sqlite3:execute db "ALTER TABLE test_data ADD COLUMN type TEXT DEFAULT '';") (patch-db)) @@ -445,11 +445,13 @@ db "SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?;" run-id test-name (item-list->path itemdat)) (for-each (lambda (id) (sqlite3:execute db "DELETE FROM test_steps WHERE test_id=?;" id) - (thread-sleep! 0.1)) ;; give others access to the db + (thread-sleep! 0.1) ;; give others access to the db + (sqlite3:execute db "DELETE FROM test_data WHERE test_id=?;" id) + (thread-sleep! 0.1)) ;; give others access to the db ids))) ;;"DELETE FROM test_steps WHERE test_id in (SELECT id FROM tests WHERE run_id=? AND testname=? AND item_path=?);" ;; (define (db:delete-test-records db test-id) @@ -550,12 +552,14 @@ db "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" rundir run-id test-name item-path)) (define (db:test-set-log! db run-id test-name item-path logf) - (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path=?;" - logf run-id test-name item-path)) + (if (string? logf) + (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path=?;" + logf run-id test-name item-path) + (debug:print 0 "ERROR: db:test-set-log! called with non-string log file name " logf))) ;;====================================================================== ;; Misc. test related queries ;;====================================================================== Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -44,11 +44,12 @@ (and logpro (eq? exitcode 2)))) (define (launch:execute encoded-cmd) (let* ((cmdinfo (read (open-input-string (base64:base64-decode encoded-cmd))))) (setenv "MT_CMDINFO" encoded-cmd) - (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) (test-name sqlitespeed) (runscript runscript.rb) (db-host localhost) (run-id 1)) + (if (list? cmdinfo) ;; ((testpath /tmp/mrwellan/jazzmind/src/example_run/tests/sqlitespeed) + ;; (test-name sqlitespeed) (runscript runscript.rb) (db-host localhost) (run-id 1)) (let* ((testpath (assoc/default 'testpath cmdinfo)) (work-area (assoc/default 'work-area cmdinfo)) (test-name (assoc/default 'test-name cmdinfo)) (runscript (assoc/default 'runscript cmdinfo)) (ezsteps (assoc/default 'ezsteps cmdinfo)) @@ -439,27 +440,30 @@ (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 + ;; 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 + (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)) (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))) ;; set up the run work area for this test (set! diskpath (get-best-disk *configdat*)) @@ -497,11 +501,10 @@ (if (not useshell)(debug:print 0 "WARNING: internal launching will not work well without \"useshell yes\" in your [jobtools] section")) (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" ""))))) (if (args:get-arg "-xterm")(set! fullcmd (append fullcmd (list "-xterm")))) (debug:print 1 "Launching megatest for test " test-name " in " work-area" ...") (test-set-status! db run-id test-name "LAUNCHED" "n/a" itemdat #f #f) ;; (if launch-results launch-results "FAILED")) - ;; set ;; set pre-launch-env-vars before launching, keep the vars in prevvals and put the envionment back when done (debug:print 4 "fullcmd: " fullcmd) (let* ((commonprevvals (alist->env-vars (hash-table-ref/default *configdat* "env-override" '()))) (testprevvals (alist->env-vars @@ -518,11 +521,11 @@ print (if useshell '() (cdr fullcmd))))) ;; launcher fullcmd)));; (apply cmd-run-proc-each-line launcher print fullcmd))) ;; (cmd-run->list fullcmd)) (debug:print 2 "Launching completed, updating db") - (debug:print 4 "Launch results: " launch-results) + (debug:print 2 "Launch results: " launch-results) (if (not launch-results) (begin (print "ERROR: Failed to run " (string-intersperse fullcmd " ") ", exiting now") (sqlite3:finalize! db) ;; good ole "exit" seems not to work Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -392,11 +392,15 @@ (setenv "MT_RUNNAME" runname) (set-megatest-env-vars db run-id) ;; these may be needed by the launching process (change-directory *toppath*) ;; Here is where the test_meta table is best updated - (runs:update-test_meta db test-name test-conf) + ;; Yes, another use of a global for caching. Need a better way? + (if (not (hash-table-ref/default *test-meta-updated* test-name #f)) + (begin + (hash-table-set! *test-meta-updated* test-name #t) + (runs:update-test_meta db test-name test-conf))) ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer")) (let* ((new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/")) (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique (testdat (db:get-test-info db run-id test-name item-path))) @@ -449,11 +453,12 @@ (else (set! runflag #f))) (debug:print 6 "RUNNING => runflag: " runflag " STATE: " (test:get-state testdat) " STATUS: " (test:get-status testdat)) (if (not runflag) (if (not parent-test) (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"" (test:get-state testdat) - "\" and status \"" (test:get-status testdat) "\", use -rerun \"" (test:get-status testdat) "\" or -force to override")) + "\" and status \"" (test:get-status testdat) "\", use -rerun \"" (test:get-status testdat) + "\" or -force to override")) ;; NOTE: No longer be checking prerequisites here! Will never get here unless prereqs are ;; already met. (if (not (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat flags)) (begin (print "ERROR: Failed to launch the test. Exiting as soon as possible") Index: server.scm ================================================================== --- server.scm +++ server.scm @@ -82,11 +82,11 @@ (db:test-set-state-status-by-run-id-testname db run-id test-name item-path status state))) (rpc:publish-procedure! 'rdb:csv->test-data (lambda (test-id csvdata) - (db:csv->data db test-id csvdata))) + (db:csv->test-data db test-id csvdata))) (rpc:publish-procedure! 'rdb:roll-up-pass-fail-counts (lambda (run-id test-name item-path status) (db:roll-up-pass-fail-counts db run-id test-name item-path status))) Index: tests/Makefile ================================================================== --- tests/Makefile +++ tests/Makefile @@ -6,11 +6,11 @@ runall : cd ../;make install mkdir -p /tmp/mt_runs /tmp/mt_links $(BINPATH)/dboard -rows 15 & - $(MEGATEST) -runall -target ubuntu/nfs/none :runname `date +w%V.%u.%H` -m "This is a comment specific to a run" -v + $(MEGATEST) -runall -target ubuntu/nfs/none :runname `date +w%V.%u.%H` -m "This is a comment specific to a run" -v -server - test : csi -b -I .. ../megatest.scm -- -runall -target ubuntu/afs/tmp :runname blah cd ../;make test make runall Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -7,11 +7,11 @@ # exectutable /path/to/megatest max_concurrent_jobs 200 linktree /tmp/mt_links [jobtools] -# useshell yes +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 nodanggood Index: utils/mt_ezstep ================================================================== --- utils/mt_ezstep +++ utils/mt_ezstep @@ -27,14 +27,18 @@ # source the environment from the previous step if it exists # if a logpro file exists then use it otherwise just run the command, nb// was using 2>&1 if [ -e ${stepname}.logpro ];then - $command 2>&1| logpro ${stepname}.logpro ${stepname}.html &> ${stepname}.log + # could do: + $command 2>&1| tee ${stepname}.log | logpro ${stepname}.logpro ${stepname}.html &> /dev/null + logprostatus=$? + # $command 2>&1| logpro ${stepname}.logpro ${stepname}.html &> ${stepname}.log + # allstatus=(${PIPESTATUS[0]} ${PIPESTATUS[1]}) allstatus=(${PIPESTATUS[0]} ${PIPESTATUS[1]}) runstatus=${allstatus[0]} - logprostatus=${allstatus[1]} + # logprostatus=${allstatus[1]} else $command &> ${stepname}.log runstatus=$? logprostatus=$runstatus fi