Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -126,20 +126,20 @@ units TEXT, comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', type TEXT DEFAULT '', CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));") - (sqlite3:execute db "CREATE TABLE IF NOT EXISTS task_queue (id INTEGER PRIMARY KEY, + (sqlite3:execute db "CREATE TABLE IF NOT EXISTS tasks_queue (id INTEGER PRIMARY KEY, action TEXT DEFAULT '', owner TEXT, state TEXT DEFAULT 'new', target TEXT DEFAULT '', name TEXT DEFAULT '', test TEXT DEFAULT '', item TEXT DEFAULT '', creation_time TIMESTAMP, - execution_time TIMESTAMP;") + execution_time TIMESTAMP);") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY, pid INTEGER, start_time TIMESTAMP, last_update TIMESTAMP, hostname TEXT, @@ -190,17 +190,17 @@ (sqlite3:execute db "DROP TABLE IF EXISTS metadat;") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS metadat (id INTEGER, var TEXT, val TEXT, CONSTRAINT metadat_constraint UNIQUE (var));") (db:set-var db "MEGATEST_VERSION" 1.21) ;; set before, just in case the changes are already applied (sqlite3:execute db test-meta-def) - (for-each - (lambda (stmt) - (sqlite3:execute db stmt)) - (list - "ALTER TABLE tests ADD COLUMN first_err TEXT;" - "ALTER TABLE tests ADD COLUMN first_warn TEXT;" - )) + ;(for-each + ; (lambda (stmt) + ; (sqlite3:execute db stmt)) + ; (list + ; "ALTER TABLE tests ADD COLUMN first_err TEXT;" + ; "ALTER TABLE tests ADD COLUMN first_warn TEXT;" + ; )) (patch-db)) ((< mver 1.24) (db:set-var db "MEGATEST_VERSION" 1.24) (sqlite3:execute db "DROP TABLE IF EXISTS test_data;") (sqlite3:execute db "DROP TABLE IF EXISTS test_meta;") @@ -282,10 +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) (if (null? header) #f (let loop ((hed (car header)) (tal (cdr header)) (n 0)) (if (equal? hed field) @@ -364,10 +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) (sqlite3:for-each-row (lambda (a . x) (set! res (apply vector a x))) db (conc "SELECT " keystr " FROM runs WHERE id=?;") @@ -395,14 +397,14 @@ (let ((res '()) (states-str (conc "('" (string-intersperse states "','") "')")) (statuses-str (conc "('" (string-intersperse statuses "','") "')")) ) (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 first-err first-warn) - (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment first-err first-warn) res))) + (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) + (set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res))) db - (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment,first_err,first_warn " + (conc "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment " " FROM tests WHERE run_id=? AND testname like ? AND item_path LIKE ? " " AND NOT (state in " states-str " AND status IN " statuses-str ") " " ORDER BY id DESC;") run-id (if testpatt testpatt "%") @@ -462,25 +464,25 @@ ;; NB// Sync this with runs:get-test-info (define (db:get-test-info db run-id testname item-path) (let ((res #f)) (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 first-err first-warn) - (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment first-err first-warn))) + (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment ) + (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,first_err,first_warn FROM tests WHERE run_id=? AND testname=? AND item_path=?;" + "SELECT id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment FROM tests WHERE run_id=? AND testname=? AND item_path=?;" run-id testname item-path) res)) ;; Get test data using test_id (define (db:get-test-data-by-id db test-id) (let ((res #f)) (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 first-err first-warn) - (set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment first-err first-warn))) + (lambda (id run-id testname state status event-time host cpuload diskfree uname rundir item-path run_duration final_logf comment) + (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,first_err,first_warn FROM tests WHERE id=?;" + "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) res)) (define (db:test-set-comment db run-id testname item-path comment) @@ -757,12 +759,11 @@ "Diskfree" ; 16 "Uname" ; 17 "Rundir" ; 18 "Host" ; 19 "Cpu Load" ; 20 - "Warn" ; 21 - "Error"))) ; 22 + ))) (results (list runsheader)) (testdata-header (list "Run Id" "Testname" "Item Path" "Category" "Variable" "Value" "Expected" "Tol" "Units" "Status" "Comment"))) (debug:print 2 "Using " tempdir " for constructing the ods file. keyqry: " keyqry " keystr: " keysstr " with keys: " (map cadr keypatt-alist)) ;; "Expected Value" ;; "Value Found" @@ -809,11 +810,11 @@ strftime('%m/%d/%Y %H:%M:%S',datetime(t.event_time,'unixepoch'),'localtime'), tm.tags,r.owner,t.comment, author, tm.owner,reviewed, diskfree,uname,rundir, - host,cpuload,first_err,first_warn + host,cpuload FROM tests AS t INNER JOIN runs AS r ON t.run_id=r.id INNER JOIN test_meta AS tm ON tm.testname=t.testname WHERE runname LIKE ? AND " keyqry ";") runspatt (map cadr keypatt-alist)) (set! results (list (cons "Runs" results))) ;; now, for each test, collect the test_data info and add a new sheet Index: key_records.scm ================================================================== --- key_records.scm +++ key_records.scm @@ -14,10 +14,12 @@ (define-inline (keys->valslots keys) ;; => ?,?,? .... (string-intersperse (map (lambda (x) "?") keys) ",")) (define-inline (keys->key/field keys . additional) - (string-join (map (lambda (k)(conc (key:get-fieldname k) " " (key:get-fieldtype k)))(append keys additional)) ",")) + (string-join (map (lambda (k)(conc (key:get-fieldname k) " " + (key:get-fieldtype k))) + (append keys additional)) ",")) (define-inline (item-list->path itemdat) (string-intersperse (map cadr itemdat) "/")) Index: launch.scm ================================================================== --- launch.scm +++ launch.scm @@ -354,11 +354,11 @@ ;; 3. create link from run dir to megatest runs area ;; 4. remotely run the test on allocated host ;; - could be ssh to host from hosts table (update regularly with load) ;; - could be netbatch ;; (launch-test db (cadr status) test-conf)) -(define (launch-test db run-id test-conf keyvallst test-name test-path itemdat) +(define (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat) (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 @@ -405,11 +405,11 @@ (list 'run-id run-id ) (list 'itemdat itemdat ) (list 'megatest remote-megatest) (list 'ezsteps ezsteps) (list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '())) - (list 'runname (args:get-arg ":runname")) + (list 'runname runname) (list 'mt-bindir-path mt-bindir-path))))))) ;; (string-intersperse keyvallst " ")))) ;; clean out step records from previous run if they exist (db:delete-test-step-records db run-id test-name itemdat) (change-directory work-area) ;; so that log files from the launch process don't clutter the test dir (cond @@ -431,11 +431,11 @@ (testprevvals (alist->env-vars (hash-table-ref/default test-conf "pre-launch-env-overrides" '()))) (miscprevvals (alist->env-vars ;; consolidate this code with the code in megatest.scm for "-execute" (append (list (list "MT_TEST_NAME" test-name) (list "MT_ITEM_INFO" (conc itemdat)) - (list "MT_RUNNAME" (args:get-arg ":runname"))) + (list "MT_RUNNAME" runname)) itemdat))) (launch-results (apply cmd-run-proc-each-line (if useshell (string-intersperse fullcmd " ") (car fullcmd)) Index: runs.scm ================================================================== --- runs.scm +++ runs.scm @@ -709,11 +709,11 @@ (if (not parent-test) (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override")) (let* ((get-prereqs-cmd (lambda () (db-get-prereqs-not-met db run-id waiton))) ;; check before running .... (launch-cmd (lambda () - (launch-test db run-id test-conf keyvallst test-name test-path itemdat))) + (launch-test db run-id (args:get-arg ":runname") test-conf keyvallst test-name test-path itemdat))) (testrundat (list get-prereqs-cmd launch-cmd))) (if (or (args:get-arg "-force") (let ((preqs-not-yet-met ((car testrundat)))) (debug:print 2 "Preqrequesites for " test-name ": " preqs-not-yet-met) (null? preqs-not-yet-met))) ;; are there any tests that must be run before this one... @@ -1018,11 +1018,11 @@ (if (not parent-test) (debug:print 1 "NOTE: Not starting test " new-test-name " as it is state \"COMPLETED\" and status \"" (test:get-status testdat) "\", use -force to override")) (let* ((get-prereqs-cmd (lambda () (db-get-prereqs-not-met db run-id waiton))) ;; check before running .... (launch-cmd (lambda () - (launch-test db run-id test-conf keyvallst test-name test-path itemdat))) + (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat))) (testrundat (list get-prereqs-cmd launch-cmd))) (if (or force (let ((preqs-not-yet-met ((car testrundat)))) (debug:print 2 "Preqrequesites for " test-name ": " preqs-not-yet-met) (null? preqs-not-yet-met))) ;; are there any tests that must be run before this one... Index: task_records.scm ================================================================== --- task_records.scm +++ task_records.scm @@ -19,10 +19,12 @@ (define-inline (tasks:task-get-name vec) (vector-ref vec 5)) (define-inline (tasks:task-get-test vec) (vector-ref vec 6)) (define-inline (tasks:task-get-item vec) (vector-ref vec 7)) (define-inline (tasks:task-get-creation_time vec) (vector-ref vec 8)) (define-inline (tasks:task-get-execution_time vec) (vector-ref vec 9)) + +(define-inline (tasks:task-set-state! vec val)(vector-set! vec 3 val)) ;; make-vector-record tasks monitor id pid start_time last_update hostname username (define (make-tasks:monitor)(make-vector 5)) (define-inline (tasks:monitor-get-id vec) (vector-ref vec 0)) Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -225,10 +225,15 @@ (define (tasks:remove-monitor-record db) (sqlite3:execute db "DELETE FROM monitors WHERE pid=? AND hostname=?;" (current-process-id) (get-host-name))) + +(define (tasks:set-state db task-id state) + (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) @@ -238,6 +243,7 @@ (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") ) Index: tests/megatest.config ================================================================== --- tests/megatest.config +++ tests/megatest.config @@ -7,11 +7,11 @@ # exectutable /path/to/megatest # max_concurrent_jobs 4 runsdir /tmp/runs [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