Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -266,11 +266,11 @@ (debug:print-info 11 "open-test-db END (unsucessful)" testpath) #f))) ;; find and open the testdat.db file for an existing test (define (db:open-test-db-by-test-id db test-id) - (let* ((test-path (db:test-get-rundir-from-test-id db test-id))) + (let* ((test-path (cdb:remote-run db:test-get-rundir-from-test-id db test-id))) (debug:print 3 "TEST PATH: " test-path) (open-test-db test-path))) (define (db:testdb-initialize db) (debug:print 11 "db:testdb-initialize START") @@ -915,41 +915,10 @@ (define (db:clean-all-caches) (set! *test-info* (make-hash-table)) (set! *test-id-cache* (make-hash-table))) -;; Get test data using test_id -(define (db:get-test-info-cached-by-id db test-id) - ;; is all this crap really worth it? I somehow doubt it. - (let* ((last-delete-str (db:get-var db "DELETED_TESTS")) - (last-delete (if (string? last-delete-str)(string->number last-delete-str) #f))) - (if (and last-delete (> last-delete *last-test-cache-delete*)) - (begin - (set! *test-info* (make-hash-table)) - (set! *test-id-cache* (make-hash-table)) - (set! *last-test-cache-delete* last-delete) - (debug:print-info 4 "Clearing test data cache")))) - (if (not test-id) - (begin - (debug:print-info 4 "db:get-test-info-by-id called with test-id=" test-id) - #f) - (let* ((res (hash-table-ref/default *test-info* test-id #f))) - (if (and res - (member (db:test-get-state res) '("RUNNING" "COMPLETED"))) - (db:patch-tdb-data-into-test-info db test-id res) - ;; if no cached value then full read and write to cache - (begin - (sqlite3:for-each-row - (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) - ;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 - (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment))) - db - "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE id=?;" - test-id) - (if res (db:patch-tdb-data-into-test-info db test-id res)) - res))))) - ;; Get test data using test_id (define (db:get-test-info-not-cached-by-id db test-id) (if (not test-id) (begin (debug:print-info 4 "db:get-test-info-by-id called with test-id=" test-id) @@ -1569,10 +1538,11 @@ "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) (sqlite3:finalize! tdb) (reverse res)) '()))) +;; NOTE: Run this local with #f for db !!! (define (db:load-test-data db test-id) (let loop ((lin (read-line))) (if (not (eof-object? lin)) (begin (debug:print 4 lin) @@ -1586,11 +1556,11 @@ ;; Roll up test_data pass/fail results ;; look at the test_data status field, ;; if all are pass (any case) and the test status is PASS or NULL or '' then set test status to PASS. ;; if one or more are fail (any case) then set test status to PASS, non "pass" or "fail" are ignored (define (db:test-data-rollup db test-id status) - (let ((tdb (open-run-close db:open-test-db-by-test-id db test-id)) + (let ((tdb (db:open-test-db-by-test-id db test-id)) (fail-count 0) (pass-count 0)) (if tdb (begin (sqlite3:for-each-row @@ -1770,10 +1740,11 @@ waitons) (delete-duplicates result)))) (define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile) (debug:print 4 "test-id: " test-id " teststep-name: " teststep-name) + ;; db:open-test-db-by-test-id does cdb:remote-run (let* ((tdb (db:open-test-db-by-test-id db test-id)) (state (items:check-valid-items "state" state-in)) (status (items:check-valid-items "status" status-in))) (if (or (not state)(not status)) (debug:print 3 "WARNING: Invalid " (if status "status" "state") Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -129,11 +129,12 @@ ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) (set-megatest-env-vars run-id) (set-item-env-vars itemdat) (save-environment-as-files "megatest") - (open-run-close test-set-meta-info #f test-id run-id test-name itemdat 0) + ;; open-run-close not needed for test-set-meta-info + (test-set-meta-info #f test-id run-id test-name itemdat 0) (tests:test-set-status! test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f) (if (args:get-arg "-xterm") (set! fullrunscript "xterm") (if (and fullrunscript (not (file-execute-access? fullrunscript))) (system (conc "chmod ug+x " fullrunscript)))) @@ -203,12 +204,12 @@ ;; call the command using mt_ezstep (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "-") " " stepcmd)) (debug:print 4 "script: " script) - - (cdb:remote-run db:teststep-set-status! #f test-id stepname "start" "-" #f #f) + ;; DO NOT remote + (db:teststep-set-status! #f test-id stepname "start" "-" #f #f) ;; now launch (let ((pid (process-run script))) (let processloop ((i 0)) (let-values (((pid-val exit-status exit-code)(process-wait pid #t))) (mutex-lock! m) @@ -222,11 +223,11 @@ (processloop (+ i 1)))) )) (let ((exinfo (vector-ref exit-info 2)) (logfna (if logpro-used (conc stepname ".html") ""))) ;; testing if procedures called in a remote call cause problems (ans: no or so I suspect) - (cdb:remote-run db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna)) + (db:teststep-set-status! #f test-id stepname "end" exinfo #f logfna)) (if logpro-used (cdb:test-set-log! *runremote* test-id (conc stepname ".html"))) ;; set the test final status (let* ((this-step-status (cond ((and (eq? (vector-ref exit-info 2) 2) logpro-used) 'warn) @@ -271,11 +272,12 @@ start-seconds))))) (kill-tries 0)) (let loop ((minutes (calc-minutes))) (begin (set! kill-job? (test-get-kill-request test-id)) ;; run-id test-name itemdat)) - (open-run-close test-set-meta-info #f test-id run-id test-name itemdat minutes) + ;; open-run-close not needed for test-set-meta-info + (test-set-meta-info #f test-id run-id test-name itemdat minutes) (if kill-job? (begin (mutex-lock! m) (let* ((pid (vector-ref exit-info 0))) (if (number? pid) Index: megatest.scm ================================================================== --- megatest.scm +++ megatest.scm @@ -91,10 +91,12 @@ -test-paths : get the test paths matching target, runname, item and test patterns. -list-disks : list the disks available for storing runs -list-targets : list the targets in runconfigs.config -list-db-targets : list the target combinations used in the db + -show-config : dump the internal representation of the megatest.config file + -show-runconfig : dump the internal representation of the runconfigs.config file Misc -rebuild-db : bring the database schema up to date -update-meta : update the tests metadata for all tests -env2file fname : write the environment to fname.csh and fname.sh @@ -196,10 +198,11 @@ ;; mist queries "-list-disks" "-list-targets" "-list-db-targets" "-show-runconfig" + "-show-config" ;; queries "-test-paths" ;; get path(s) to a test, ordered by youngest first "-runall" ;; run all tests "-remove-runs" @@ -335,12 +338,19 @@ targets) (set! *didsomething* #t))) (if (args:get-arg "-show-runconfig") (begin + ;; keep this one local (pp (hash-table->alist (open-run-close setup-env-defaults #f "runconfigs.config" #f #f change-env: #f))) (set! *didsomething* #t))) + +(if (args:get-arg "-show-config") + (begin + ;; keep this one local + (pp (hash-table->alist (open-run-close setup-env-defaults #f "megatest.config" #f #f change-env: #f))) + (set! *didsomething* #t))) ;;====================================================================== ;; Remove old run(s) ;;====================================================================== @@ -439,11 +449,12 @@ "\n diskfree: " (db:test-get-diskfree test) "\n uname: " (db:test-get-uname test) "\n rundir: " (db:test-get-rundir test) ) ;; Each test - (let ((steps (cdb:remote-run db:get-steps-for-test #f (db:test-get-id test)))) + ;; DO NOT remote run + (let ((steps (db:get-steps-for-test #f (db:test-get-id test)))) (for-each (lambda (step) (format #t " Step: ~20a State: ~10a Status: ~10a Time ~22a\n" (db:step-get-stepname step) @@ -580,13 +591,13 @@ (exit 1))) (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, giving up on -test-paths or -test-files, exiting") (exit 1))) - (let* ((keys (open-run-close db:get-keys db)) + (let* ((keys (cdb:remote-run db:get-keys db)) (keynames (map key:get-fieldname keys)) - (paths (open-run-close db:test-get-paths-matching db keynames target (args:get-arg "-test-files")))) + (paths (cdb:remote-run db:test-get-paths-matching db keynames target (args:get-arg "-test-files")))) (set! *didsomething* #t) (for-each (lambda (path) (print path)) paths))) ;; else do a general-run-call @@ -593,11 +604,11 @@ (general-run-call "-test-files" "Get paths to test" (lambda (target runname keys keynames keyvallst) (let* ((db #f) - (paths (open-run-close db:test-get-paths-matching db keynames target (args:get-arg "-test-files")))) + (paths (cdb:remote-run db:test-get-paths-matching db keynames target (args:get-arg "-test-files")))) (for-each (lambda (path) (print path)) paths)))))) ;;====================================================================== @@ -630,13 +641,13 @@ (exit 1))) (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, giving up on -archive, exiting") (exit 1))) - (let* ((keys (open-run-close db:get-keys db)) + (let* ((keys (cdb:remote-run db:get-keys db)) (keynames (map key:get-fieldname keys)) - (paths (open-run-close db:test-get-paths-matching db keynames target))) + (paths (cdb:remote-run db:test-get-paths-matching db keynames target))) (set! *didsomething* #t) (for-each (lambda (path) (print path)) paths))) ;; else do a general-run-call @@ -643,11 +654,11 @@ (general-run-call "-test-paths" "Get paths to tests" (lambda (target runname keys keynames keyvallst) (let* ((db #f) - (paths (open-run-close db:test-get-paths-matching db keynames target))) + (paths (cdb:remote-run db:test-get-paths-matching db keynames target))) (for-each (lambda (path) (print path)) paths)))))) ;;====================================================================== @@ -663,11 +674,11 @@ (outputfile (args:get-arg "-extract-ods")) (runspatt (args:get-arg ":runname")) (pathmod (args:get-arg "-pathmod")) (keyvalalist (keys->alist keys "%"))) (debug:print 2 "Extract ods, outputfile: " outputfile " runspatt: " runspatt " keyvalalist: " keyvalalist) - (open-run-close db:extract-ods-file db outputfile keyvalalist (if runspatt runspatt "%") pathmod))))) + (cdb:remote-run db:extract-ods-file db outputfile keyvalalist (if runspatt runspatt "%") pathmod))))) ;;====================================================================== ;; execute the test ;; - gets called on remote host ;; - receives info from the -execute param @@ -706,11 +717,12 @@ (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) (if (and state status) - (open-run-close db:teststep-set-status! db test-id step state status msg logfile) + ;; DO NOT remote run + (db:teststep-set-status! db test-id step state status msg logfile) (begin (debug:print 0 "ERROR: You must specify :state and :status with every call to -step") (exit 6)))))) (if (args:get-arg "-step") @@ -744,11 +756,11 @@ (runscript (assoc/default 'runscript cmdinfo)) (db-host (assoc/default 'db-host cmdinfo)) (run-id (assoc/default 'run-id cmdinfo)) (test-id (assoc/default 'test-id cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) - (db #f) + (db #f) ;; (open-db)) (state (args:get-arg ":state")) (status (args:get-arg ":status"))) (change-directory testpath) ;; (set! *runremote* runremote) (set! *transport-type* (string->symbol transport)) @@ -760,18 +772,21 @@ ;; can setup as client for server mode now ;; (server:client-setup) (if (args:get-arg "-load-test-data") ;; has sub commands that are rdb: - (open-run-close db:load-test-data db test-id)) + ;; DO NOT put this one into either cdb:remote-run or open-run-close + (db:load-test-data db test-id)) (if (args:get-arg "-setlog") (let ((logfname (args:get-arg "-setlog"))) (cdb:test-set-log! *runremote* test-id logfname))) (if (args:get-arg "-set-toplog") - (open-run-close tests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog"))) + ;; DO NOT run remote + (tests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog"))) (if (args:get-arg "-summarize-items") - (open-run-close tests:summarize-items db run-id test-name #t)) ;; do force here + ;; DO NOT run remote + (tests:summarize-items db run-id test-name #t)) ;; do force here (if (args:get-arg "-runstep") (if (null? remargs) (begin (debug:print 0 "ERROR: nothing specified to run!") (if db (sqlite3:finalize! db)) @@ -789,11 +804,12 @@ (else ">&"))) (fullcmd (conc "(" (string-intersperse (cons cmd params) " ") ") " redir " " logfile))) ;; mark the start of the test - (open-run-close db:teststep-set-status! db test-id stepname "start" "n/a" (args:get-arg "-m") logfile) + ;; DO NOT run remote + (db:teststep-set-status! db test-id stepname "start" "n/a" (args:get-arg "-m") logfile) ;; run the test step (debug:print-info 2 "Running \"" fullcmd "\"") (change-directory startingdir) (set! exitstat (system fullcmd)) ;; cmd params)) (set! *globalexitstatus* exitstat) @@ -808,11 +824,12 @@ (set! exitstat (system cmd)) (set! *globalexitstatus* exitstat) ;; no necessary (change-directory testpath) (cdb:test-set-log! *runremote* test-id htmllogfile))) (let ((msg (args:get-arg "-m"))) - (open-run-close db:teststep-set-status! db test-id stepname "end" exitstat msg logfile)) + ;; DO NOT run remote + (db:teststep-set-status! db test-id stepname "end" exitstat msg logfile)) ))) (if (or (args:get-arg "-test-status") (args:get-arg "-set-values")) (let ((newstatus (cond ((number? status) (if (equal? status 0) "PASS" "FAIL")) @@ -850,11 +867,11 @@ (keys #f)) (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) - (set! keys (open-run-close db:get-keys db)) + (set! keys (cbd:remote-run db:get-keys db)) (debug:print 1 "Keys: " (string-intersperse (map key:get-fieldname keys) ", ")) (if db (sqlite3:finalize! db)) (set! *didsomething* #t))) (if (args:get-arg "-gui") @@ -881,10 +898,11 @@ (begin (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) + ;; keep this one local (open-run-close patch-db #f) (set! *didsomething* #t))) ;;====================================================================== ;; Update the tests meta data from the testconfig files @@ -895,10 +913,11 @@ (if (not (setup-for-run)) (begin (debug:print 0 "Failed to setup, exiting") (exit 1))) ;; now can find our db + ;; keep this one local (open-run-close runs:update-all-test_meta db) (set! *didsomething* #t))) ;;====================================================================== ;; Start a repl Index: tests.scm ================================================================== --- tests.scm +++ tests.scm @@ -484,36 +484,34 @@ (set! res count)) tdb "SELECT count(id) FROM test_rundat;") res)) 0) + +(define (db:update-central-meta-info db test-id cpuload diskfree minutes num-records uname hostname) + (sqlite3:execute db "UPDATE tests SET cpuload=?,diskfree=? WHERE id=?;" + cpuload + diskfree + test-id) + (if minutes (sqlite3:execute db "UPDATE tests SET run_duration=? WHERE id=?;" minutes test-id)) + (if (eq? num-records 0) + (sqlite3:execute db "UPDATE tests SET uname=?,host=? WHERE id=?;" + uname hostname test-id))) (define (test-set-meta-info db test-id run-id testname itemdat minutes) + ;; DOES cdb:remote-run under the hood! (let* ((tdb (db:open-test-db-by-test-id db test-id)) (num-records (test:tdb-get-rundat-count tdb)) - (item-path (item-list->path itemdat)) (cpuload (get-cpu-load)) (diskfree (get-df (current-directory)))) (if (eq? (modulo num-records 10) 0) ;; every ten records update central - (begin - (sqlite3:execute db "UPDATE tests SET cpuload=?,diskfree=? WHERE run_id=? AND testname=? AND item_path=?;" - cpuload - diskfree - run-id - testname - item-path) - (if minutes (sqlite3:execute db "UPDATE tests SET run_duration=? WHERE id=?;" minutes test-id)) - (if (eq? num-records 0) - (let ((uname (get-uname "-srvpio")) - (hostname (get-host-name))) - (sqlite3:execute db "UPDATE tests SET uname=?,host=? WHERE run_id=? AND testname=? AND item_path=?;" - uname hostname run-id testname item-path))))) - + (let ((uname (get-uname "-srvpio")) + (hostname (get-host-name))) + (cdb:remote-run db:update-central-meta-info db test-id cpuload diskfree minutes num-records uname hostname))) (sqlite3:execute tdb "INSERT INTO test_rundat (update_time,cpuload,diskfree,run_duration) VALUES (strftime('%s','now'),?,?,?);" cpuload diskfree minutes))) - ;;====================================================================== ;; A R C H I V I N G ;;====================================================================== (define (test:archive db test-id)