Overview
| Comment: | Added capture and display of top script pid |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
4911da85d8e40bd38621b029cf28a8d8 |
| User & Date: | matt on 2014-10-20 00:23:05 |
| Other Links: | branch diff | manifest | tags |
Context
|
2014-10-20
| ||
| 15:00 | Added testsuite name tagging of servers, bumped version to v1.6004, move sending of kill to inside the error handling check-in: 7faccb94b1 user: mrwellan tags: v1.60 | |
| 00:23 | Added capture and display of top script pid check-in: 4911da85d8 user: matt tags: v1.60 | |
|
2014-10-19
| ||
| 21:53 | Better control over processing #{} vs. [] in config files check-in: a492699b81 user: matt tags: v1.60 | |
Changes
Modified api.scm from [859483d7bd] to [2952b351e1].
| ︙ | ︙ | |||
24 25 26 27 28 29 30 31 32 33 34 35 36 37 |
get-count-tests-running
get-count-tests-running-in-jobgroup
get-previous-test-run-record
get-matching-previous-test-run-records
test-get-logfile-info
test-get-records-for-index-file
get-testinfo-state-status
test-get-paths-matching-keynames-target-new
get-prereqs-not-met
get-count-tests-running-for-run-id
get-run-info
get-run-status
register-run
get-tests-for-run
| > | 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 |
get-count-tests-running
get-count-tests-running-in-jobgroup
get-previous-test-run-record
get-matching-previous-test-run-records
test-get-logfile-info
test-get-records-for-index-file
get-testinfo-state-status
test-get-top-process-pid
test-get-paths-matching-keynames-target-new
get-prereqs-not-met
get-count-tests-running-for-run-id
get-run-info
get-run-status
register-run
get-tests-for-run
|
| ︙ | ︙ | |||
71 72 73 74 75 76 77 78 79 80 81 82 83 84 |
((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
((test-set-status-state) (apply db:test-set-status-state dbstruct params))
((get-previous-test-run-record) (apply db:get-previous-test-run-record dbstruct params))
((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
((test-get-logfile-info) (apply db:test-get-logfile-info dbstruct params))
((test-get-records-for-index-file) (apply db:test-get-records-for-index-file dbstruct params))
((get-testinfo-state-status) (apply db:get-testinfo-state-status dbstruct params))
((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params))
((roll-up-pass-fail-counts) (apply db:roll-up-pass-fail-counts dbstruct params))
((update-fail-pass-counts) (apply db:general-call dbstruct 'update-pass-fail-counts params))
((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
;; RUNS
| > > | 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 |
((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
((test-set-status-state) (apply db:test-set-status-state dbstruct params))
((get-previous-test-run-record) (apply db:get-previous-test-run-record dbstruct params))
((get-matching-previous-test-run-records)(apply db:get-matching-previous-test-run-records dbstruct params))
((test-get-logfile-info) (apply db:test-get-logfile-info dbstruct params))
((test-get-records-for-index-file) (apply db:test-get-records-for-index-file dbstruct params))
((get-testinfo-state-status) (apply db:get-testinfo-state-status dbstruct params))
((test-set-top-process-pid) (apply db:test-set-top-process-pid dbstruct params))
((test-get-top-process-pid) (apply db:test-get-top-process-pid dbstruct params))
((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new dbstruct params))
((get-prereqs-not-met) (apply db:get-prereqs-not-met dbstruct params))
((roll-up-pass-fail-counts) (apply db:roll-up-pass-fail-counts dbstruct params))
((update-fail-pass-counts) (apply db:general-call dbstruct 'update-pass-fail-counts params))
((get-count-tests-running-for-run-id) (apply db:get-count-tests-running-for-run-id dbstruct params))
;; RUNS
|
| ︙ | ︙ |
Modified dashboard-tests.scm from [5aa3eae6d0] to [701f564f5d].
| ︙ | ︙ | |||
126 127 128 129 130 131 132 | (append (map (lambda (val) (iup:label val ; #:expand "HORIZONTAL" )) (list "Author: " "Owner: " "Reviewed: " "Tags: " | | < | 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 |
(append (map (lambda (val)
(iup:label val ; #:expand "HORIZONTAL"
))
(list "Author: "
"Owner: "
"Reviewed: "
"Tags: "
"Description: "))
(list (iup:label "" #:expand "VERTICAL"))))
(apply iup:vbox ; #:expand "YES"
(list
(store-meta "author"
(iup:label (db:testmeta-get-author testmeta) #:expand "HORIZONTAL")
(lambda (testmeta)(db:testmeta-get-author testmeta)))
(store-meta "owner"
|
| ︙ | ︙ | |||
195 196 197 198 199 200 201 | (iup:label val ; #:expand "HORIZONTAL" )) (list "Hostname: " "Uname -a: " "Disk free: " "CPU Load: " "Run duration: " | | > | 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 |
(iup:label val ; #:expand "HORIZONTAL"
))
(list "Hostname: "
"Uname -a: "
"Disk free: "
"CPU Load: "
"Run duration: "
"Logfile: "
"Top process id: "))
(iup:label "" #:expand "VERTICAL")))
(apply iup:vbox ; #:expand "YES"
(list
;; NOTE: Yes, the host can change!
(store-label "HostName"
(iup:label ;; (sdb:qry 'getstr
(db:test-get-host testdat) ;; )
|
| ︙ | ︙ | |||
218 219 220 221 222 223 224 | (lambda (testdat)(conc (db:test-get-diskfree testdat)))) (store-label "CPULoad" (iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL") (lambda (testdat)(conc (db:test-get-cpuload testdat)))) (store-label "RunDuration" (iup:label (conc (seconds->hr-min-sec (db:test-get-run_duration testdat))) #:expand "HORIZONTAL") (lambda (testdat)(conc (seconds->hr-min-sec (db:test-get-run_duration testdat))))) | | | > > > > | 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 | (lambda (testdat)(conc (db:test-get-diskfree testdat)))) (store-label "CPULoad" (iup:label (conc (db:test-get-cpuload testdat)) #:expand "HORIZONTAL") (lambda (testdat)(conc (db:test-get-cpuload testdat)))) (store-label "RunDuration" (iup:label (conc (seconds->hr-min-sec (db:test-get-run_duration testdat))) #:expand "HORIZONTAL") (lambda (testdat)(conc (seconds->hr-min-sec (db:test-get-run_duration testdat))))) (store-label "LogFile" (iup:label (conc (db:test-get-final_logf testdat)) #:expand "HORIZONTAL") (lambda (testdat)(conc (db:test-get-final_logf testdat)))) (store-label "ProcessId" (iup:label (conc (db:test-get-process_id testdat)) #:expand "HORIZONTAL") (lambda (testdat)(conc (db:test-get-process_id testdat)))) ))))) ;; use a global for setting the buttons colors ;; state status teststeps (define *state-status* (vector #f #f #f)) (define (update-state-status-buttons testdat) (let* ((state (db:test-get-state testdat)) (status (db:test-get-status testdat)) |
| ︙ | ︙ |
Modified db.scm from [3d37442279] to [b706df4bfb].
| ︙ | ︙ | |||
1660 1661 1662 1663 1664 1665 1666 1667 1668 |
(define (db:get-test-id dbstruct run-id testname item-path)
(let* ((db (db:get-db dbstruct run-id)))
(db:first-result-default
(db:get-db dbstruct run-id)
"SELECT id FROM tests WHERE testname=? AND item_path=?;"
#f ;; the default
testname item-path)))
(define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time"
| > > > > > > > > > > > | | > | | | | 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 1695 1696 1697 1698 1699 1700 1701 1702 1703 1704 1705 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 |
(define (db:get-test-id dbstruct run-id testname item-path)
(let* ((db (db:get-db dbstruct run-id)))
(db:first-result-default
(db:get-db dbstruct run-id)
"SELECT id FROM tests WHERE testname=? AND item_path=?;"
#f ;; the default
testname item-path)))
;; overload the unused attemptnum field for the process id of the runscript or
;; ezsteps step script in progress
;;
(define (db:test-set-top-process-pid dbstruct run-id test-id pid)
(sqlite3:execute (db:get-db dbstruct run-id) "UPDATE tests SET attemptnum=? WHERE id=?;"
pid test-id))
(define (db:test-get-top-process-pid dbstruct run-id test-id)
(sqlite3:first-result (db:get-db dbstruct run-id) "SELECT attemptnum FROM tests WHERE id=?;"
run-id test-id))
(define db:test-record-fields '("id" "run_id" "testname" "state" "status" "event_time"
"host" "cpuload" "diskfree" "uname" "rundir" "item_path"
"run_duration" "final_logf" "comment" "shortdir" "attemptnum"))
;; fields *must* be a non-empty list
;;
(define (db:field->number fieldname fields)
(if (null? fields)
#f
(let loop ((hed (car fields))
(tal (cdr fields))
(indx 0))
(if (equal? fieldname hed)
indx
(if (null? tal)
#f
(loop (car tal)(cdr tal)(+ indx 1)))))))
(define db:test-record-qry-selector (string-intersperse db:test-record-fields ","))
;; NOTE: Use db:test-get* to access records
;; NOTE: This needs rundir decoding? Decide, decode here or where used? For the moment decode where used.
(define (db:get-all-tests-info-by-run-id dbstruct run-id)
(let ((db (db:get-db dbstruct run-id))
(res '()))
(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 shortdir attemptnum)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
(set! res (cons (vector id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment shortdir attemptnum)
res)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE state != 'DELETED' AND run_id=?;")
run-id)
res))
(define (db:replace-test-records dbstruct run-id testrecs)
|
| ︙ | ︙ | |||
1759 1760 1761 1762 1763 1764 1765 |
(db:prep-megatest.db-adj-test-ids mtdb run-id testrecs)))
run-ids)))
;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
(let ((db (db:get-db dbstruct run-id))
(res #f))
| | | | | | 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783 1784 1785 1786 1787 1788 |
(db:prep-megatest.db-adj-test-ids mtdb run-id testrecs)))
run-ids)))
;; Get test data using test_id
(define (db:get-test-info-by-id dbstruct run-id test-id)
(let ((db (db:get-db dbstruct run-id))
(res #f))
(sqlite3:for-each-row ;; attemptnum added to hold pid of top process (not Megatest) controlling a test
(lambda (id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum)
;; 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
(set! res (vector id run-id testname state status event-time host cpuload diskfree uname rundir-id item-path run_duration final-logf-id comment short-dir-id attemptnum)))
(db:get-db dbstruct run-id)
(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id=?;")
test-id)
res))
;; Use db:test-get* to access
;; Get test data using test_ids. NB// Only works within a single run!!
|
| ︙ | ︙ |
Modified db_records.scm from [828e5a591d] to [8738c33604].
| ︙ | ︙ | |||
74 75 76 77 78 79 80 | (define-inline (db:test-get-uname vec) (vector-ref vec 9)) ;; (define-inline (db:test-get-rundir vec) (sdb:qry 'getstr (vector-ref vec 10))) (define-inline (db:test-get-rundir vec) (vector-ref vec 10)) (define-inline (db:test-get-item-path vec) (vector-ref vec 11)) (define-inline (db:test-get-run_duration vec) (vector-ref vec 12)) (define-inline (db:test-get-final_logf vec) (vector-ref vec 13)) (define-inline (db:test-get-comment vec) (vector-ref vec 14)) | > | | | 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | (define-inline (db:test-get-uname vec) (vector-ref vec 9)) ;; (define-inline (db:test-get-rundir vec) (sdb:qry 'getstr (vector-ref vec 10))) (define-inline (db:test-get-rundir vec) (vector-ref vec 10)) (define-inline (db:test-get-item-path vec) (vector-ref vec 11)) (define-inline (db:test-get-run_duration vec) (vector-ref vec 12)) (define-inline (db:test-get-final_logf vec) (vector-ref vec 13)) (define-inline (db:test-get-comment vec) (vector-ref vec 14)) (define-inline (db:test-get-process_id vec) (vector-ref vec 16)) ;; (define-inline (db:test-get-pass_count vec) (vector-ref vec 15)) ;; (define-inline (db:test-get-fail_count vec) (vector-ref vec 16)) (define-inline (db:test-get-fullname vec) (conc (db:test-get-testname vec) "/" (db:test-get-item-path vec))) (define-inline (db:test-get-first_err vec) (printable (vector-ref vec 15))) (define-inline (db:test-get-first_warn vec) (printable (vector-ref vec 16))) (define-inline (db:test-set-cpuload! vec val)(vector-set! vec 7 val)) |
| ︙ | ︙ |
Modified launch.scm from [acb41eb596] to [32a59e3cd5].
| ︙ | ︙ | |||
205 206 207 208 209 210 211 212 213 214 215 216 217 218 | (tests:test-force-state-status! run-id test-id "RUNNING" "n/a") (rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING") (thread-sleep! 0.3) ;; NFS slowness has caused grief here ;; if there is a runscript do it first (if fullrunscript (let ((pid (process-run fullrunscript))) (let loop ((i 0)) (let-values (((pid-val exit-status exit-code) (process-wait pid #t))) (mutex-lock! m) (vector-set! exit-info 0 pid) (vector-set! exit-info 1 exit-status) (vector-set! exit-info 2 exit-code) | > | 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | (tests:test-force-state-status! run-id test-id "RUNNING" "n/a") (rmt:roll-up-pass-fail-counts run-id test-name item-path "RUNNING") (thread-sleep! 0.3) ;; NFS slowness has caused grief here ;; if there is a runscript do it first (if fullrunscript (let ((pid (process-run fullrunscript))) (rmt:test-set-top-process-pid run-id test-id pid) (let loop ((i 0)) (let-values (((pid-val exit-status exit-code) (process-wait pid #t))) (mutex-lock! m) (vector-set! exit-info 0 pid) (vector-set! exit-info 1 exit-status) (vector-set! exit-info 2 exit-code) |
| ︙ | ︙ | |||
260 261 262 263 264 265 266 267 268 269 270 271 272 273 | ;; call the command using mt_ezstep (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "-") " " stepcmd)) (debug:print 4 "script: " script) (rmt:teststep-set-status! run-id 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) (vector-set! exit-info 0 pid) (vector-set! exit-info 1 exit-status) (vector-set! exit-info 2 exit-code) (mutex-unlock! m) | > | 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 | ;; call the command using mt_ezstep (set! script (conc "mt_ezstep " stepname " " (if prevstep prevstep "-") " " stepcmd)) (debug:print 4 "script: " script) (rmt:teststep-set-status! run-id test-id stepname "start" "-" #f #f) ;; now launch (let ((pid (process-run script))) (rmt:test-set-top-process-pid run-id test-id pid) (let processloop ((i 0)) (let-values (((pid-val exit-status exit-code)(process-wait pid #t))) (mutex-lock! m) (vector-set! exit-info 0 pid) (vector-set! exit-info 1 exit-status) (vector-set! exit-info 2 exit-code) (mutex-unlock! m) |
| ︙ | ︙ |
Modified rmt.scm from [7baaea28d7] to [e9f97710c6].
| ︙ | ︙ | |||
314 315 316 317 318 319 320 321 322 323 324 325 326 327 | (define (rmt:get-testinfo-state-status run-id test-id) (rmt:send-receive 'get-testinfo-state-status run-id (list run-id test-id))) (define (rmt:test-set-log! run-id test-id logf) (if (string? logf)(rmt:general-call 'test-set-log run-id logf test-id))) (define (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt) (rmt:send-receive 'get-run-ids-matching-target #f (list keynames target res runname testpatt statepatt statuspatt))) ;; NOTE: This will open and access ALL run databases. ;; (define (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname) (let ((run-ids (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt))) | > > > > > > | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 | (define (rmt:get-testinfo-state-status run-id test-id) (rmt:send-receive 'get-testinfo-state-status run-id (list run-id test-id))) (define (rmt:test-set-log! run-id test-id logf) (if (string? logf)(rmt:general-call 'test-set-log run-id logf test-id))) (define (rmt:test-set-top-process-pid run-id test-id pid) (rmt:send-receive 'test-set-top-process-pid run-id (list run-id test-id pid))) (define (rmt:test-get-top-process-pid run-id test-id) (rmt:send-receive 'test-get-top-process-pid run-id (list run-id test-id))) (define (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt) (rmt:send-receive 'get-run-ids-matching-target #f (list keynames target res runname testpatt statepatt statuspatt))) ;; NOTE: This will open and access ALL run databases. ;; (define (rmt:test-get-paths-matching-keynames-target-new keynames target res testpatt statepatt statuspatt runname) (let ((run-ids (rmt:get-run-ids-matching-target keynames target res runname testpatt statepatt statuspatt))) |
| ︙ | ︙ |