Overview
Comment: | Changed some calls using status-state order to state-status to be consistent and easier to read. |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.63-stackdumpfix |
Files: | files | file ages | folders |
SHA1: |
bf1dd4b5fc3896a87539cf053b96814f |
User & Date: | matt on 2017-01-07 17:07:20 |
Other Links: | branch diff | manifest | tags |
Context
2017-01-07
| ||
20:32 | Renamed roll-up-pass-fail-counts to set-state-statue-and-roll-up-items Added error message when old vesion of logpro used (causes problems with .dat files in tests) check-in: 1b7a0ba2b7 user: matt tags: v1.63-stackdumpfix | |
17:07 | Changed some calls using status-state order to state-status to be consistent and easier to read. check-in: bf1dd4b5fc user: matt tags: v1.63-stackdumpfix | |
2017-01-06
| ||
22:37 | Made mt:process-triggers run exclusively on the server side check-in: bcaec59285 user: matt tags: v1.63-stackdumpfix | |
Changes
Modified api.scm from [1debddd502] to [d2e49fe3dc].
︙ | ︙ | |||
70 71 72 73 74 75 76 | start-server kill-server ;; TESTS test-set-state-status-by-id delete-test-records delete-old-deleted-test-records | | | 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 | start-server kill-server ;; TESTS test-set-state-status-by-id delete-test-records delete-old-deleted-test-records test-set-state-status test-set-top-process-pid roll-up-pass-fail-counts update-pass-fail-counts top-test-set-per-pf-counts ;; (db:top-test-set-per-pf-counts (db:get-db *db* 5) 5 "runfirst") ;; RUNS register-run |
︙ | ︙ | |||
138 139 140 141 142 143 144 | ((start-server) (apply server:kind-run params)) ((kill-server) (set! *server-run* #f)) ;; TESTS ((test-set-state-status-by-id) (apply db:test-set-state-status-by-id dbstruct params)) ((delete-test-records) (apply db:delete-test-records dbstruct params)) ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params)) | | | 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 | ((start-server) (apply server:kind-run params)) ((kill-server) (set! *server-run* #f)) ;; TESTS ((test-set-state-status-by-id) (apply db:test-set-state-status-by-id dbstruct params)) ((delete-test-records) (apply db:delete-test-records dbstruct params)) ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params)) ((test-set-state-status) (apply db:test-set-state-status dbstruct params)) ((test-set-top-process-pid) (apply db:test-set-top-process-pid dbstruct params)) ((roll-up-pass-fail-counts) (apply db:roll-up-pass-fail-counts dbstruct params)) ;; ((update-pass-fail-counts) (apply db:general-call dbstruct 'update-pass-fail-counts params)) ((top-test-set-per-pf-counts) (apply db:top-test-set-per-pf-counts dbstruct params)) ((test-set-archive-block-id) (apply db:test-set-archive-block-id dbstruct params)) ;; RUNS |
︙ | ︙ |
Modified db.scm from [aa5dac4609] to [a1b8236ecc].
︙ | ︙ | |||
1498 1499 1500 1501 1502 1503 1504 | (min-incompleted-ids (map car incompleted)) ;; do 'em all (all-ids (append min-incompleted-ids (map car oldlaunched)))) (if (> (length all-ids) 0) (begin (debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE") (for-each (lambda (test-id) | | | 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 | (min-incompleted-ids (map car incompleted)) ;; do 'em all (all-ids (append min-incompleted-ids (map car oldlaunched)))) (if (> (length all-ids) 0) (begin (debug:print 0 *default-log-port* "WARNING: Marking test(s); " (string-intersperse (map conc all-ids) ", ") " as INCOMPLETE") (for-each (lambda (test-id) (db:test-set-state-status dbstruct run-id test-id "COMPLETE" "DEAD" "Test failed to complete")) all-ids)))))) ;; ALL REPLACED BY THE BLOCK ABOVE ;; ;; (sqlite3:execute ;; db ;; (conc "UPDATE tests SET state='INCOMPLETE' WHERE run_id=? AND id IN (" |
︙ | ︙ | |||
3142 3143 3144 3145 3146 3147 3148 | (debug:print-error 0 *default-log-port* "reception failed. Received \"" msg "\" but cannot translate it.") (print-call-chain (current-error-port)) msg))) ;; crude reply for when things go awry ((zmq nmsg)(with-input-from-string msg (lambda ()(deserialize)))) (else msg))) ;; rpc ;; This is to be the big daddy call | | | | 3142 3143 3144 3145 3146 3147 3148 3149 3150 3151 3152 3153 3154 3155 3156 3157 | (debug:print-error 0 *default-log-port* "reception failed. Received \"" msg "\" but cannot translate it.") (print-call-chain (current-error-port)) msg))) ;; crude reply for when things go awry ((zmq nmsg)(with-input-from-string msg (lambda ()(deserialize)))) (else msg))) ;; rpc ;; This is to be the big daddy call ;; (define (db:test-set-state-status dbstruct run-id test-id state status msg) (let ((dbdat (db:get-db dbstruct run-id))) (if (member state '("LAUNCHED" "REMOTEHOSTSTART")) (db:general-call dbdat 'set-test-start-time (list test-id))) ;; (if msg ;; (db:general-call dbdat 'state-status-msg (list state status msg test-id)) ;; (db:general-call dbdat 'state-status (list state status test-id))) (db:set-state-status-and-roll-up-items dbstruct run-id test-id #f state status msg) |
︙ | ︙ |
Modified launch.scm from [5acd6fa77a] to [f70ed8352b].
︙ | ︙ | |||
455 456 457 458 459 460 461 | (let ((sighand (lambda (signum) ;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting (if (eq? signum signal/stop) (debug:print-error 0 *default-log-port* "attempt to STOP process. Exiting.")) (set! *time-to-exit* #t) (print "Received signal " signum ", cleaning up before exit. Please wait...") (let ((th1 (make-thread (lambda () | | | 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 | (let ((sighand (lambda (signum) ;; (signal-mask! signum) ;; to mask or not? seems to cause issues in exiting (if (eq? signum signal/stop) (debug:print-error 0 *default-log-port* "attempt to STOP process. Exiting.")) (set! *time-to-exit* #t) (print "Received signal " signum ", cleaning up before exit. Please wait...") (let ((th1 (make-thread (lambda () (rmt:test-set-state-status run-id test-id "INCOMPLETE" "KILLED" #f) (print "Killed by signal " signum ". Exiting") (thread-sleep! 1) (exit 1)))) (th2 (make-thread (lambda () (thread-sleep! 2) (debug:print 0 *default-log-port* "Done") (exit 4))))) |
︙ | ︙ | |||
479 480 481 482 483 484 485 | ;; (let* ((test-info (rmt:get-test-info-by-id run-id test-id)) (test-host (db:test-get-host test-info)) (test-pid (db:test-get-process_id test-info))) (cond ((member (db:test-get-state test-info) '("INCOMPLETE" "KILLED" "UNKNOWN" "KILLREQ" "STUCK")) ;; prior run of this test didn't complete, go ahead and try to rerun (debug:print 0 *default-log-port* "INFO: test is INCOMPLETE or KILLED, treat this execute call as a rerun request") | | > > | > > | > > | 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 | ;; (let* ((test-info (rmt:get-test-info-by-id run-id test-id)) (test-host (db:test-get-host test-info)) (test-pid (db:test-get-process_id test-info))) (cond ((member (db:test-get-state test-info) '("INCOMPLETE" "KILLED" "UNKNOWN" "KILLREQ" "STUCK")) ;; prior run of this test didn't complete, go ahead and try to rerun (debug:print 0 *default-log-port* "INFO: test is INCOMPLETE or KILLED, treat this execute call as a rerun request") ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a") (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f) ) ;; prime it for running ((member (db:test-get-state test-info) '("RUNNING" "REMOTEHOSTSTART")) (if (process:alive-on-host? test-host test-pid) (debug:print-error 0 *default-log-port* "test state is " (db:test-get-state test-info) " and process " test-pid " is still running on host " test-host ", cannot proceed") ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a") (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f) )) ((not (member (db:test-get-state test-info) '("REMOVING" "REMOTEHOSTSTART" "RUNNING" "KILLREQ"))) ;; (tests:test-force-state-status! run-id test-id "REMOTEHOSTSTART" "n/a") (rmt:test-set-state-status run-id test-id "REMOTEHOSTSTART" "n/a" #f) ) (else ;; (member (db:test-get-state test-info) '("REMOVING" "REMOTEHOSTSTART" "RUNNING" "KILLREQ")) (debug:print-error 0 *default-log-port* "test state is " (db:test-get-state test-info) ", cannot proceed") (exit)))) (debug:print 2 *default-log-port* "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) (set! keys (rmt:get-keys)) ;; (runs:set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals) ;; these may be needed by the launching process |
︙ | ︙ |
Modified rmt.scm from [ef5ad8a7b9] to [7d1f6912f1].
︙ | ︙ | |||
499 500 501 502 503 504 505 | (rmt:send-receive 'delete-test-records run-id (list run-id test-id))) ;; This is not needed as test steps are deleted on test delete call ;; ;; (define (rmt:delete-test-step-records run-id test-id) ;; (rmt:send-receive 'delete-test-step-records run-id (list run-id test-id))) | | | | 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 | (rmt:send-receive 'delete-test-records run-id (list run-id test-id))) ;; This is not needed as test steps are deleted on test delete call ;; ;; (define (rmt:delete-test-step-records run-id test-id) ;; (rmt:send-receive 'delete-test-step-records run-id (list run-id test-id))) (define (rmt:test-set-state-status run-id test-id state status msg) (rmt:send-receive 'test-set-state-status run-id (list run-id test-id state status msg))) (define (rmt:test-toplevel-num-items run-id test-name) (rmt:send-receive 'test-toplevel-num-items run-id (list run-id test-name))) ;; (define (rmt:get-previous-test-run-record run-id test-name item-path) ;; (rmt:send-receive 'get-previous-test-run-record run-id (list run-id test-name item-path))) |
︙ | ︙ |
Modified tests.scm from [585eeaa784] to [5611a205a2].
︙ | ︙ | |||
349 350 351 352 353 354 355 | (if (null? tal) #t (loop (car tal)(cdr tal))) #f)))))) (pop-directory) result))))) | < < < < < | 349 350 351 352 353 354 355 356 357 358 359 360 361 362 | (if (null? tal) #t (loop (car tal)(cdr tal))) #f)))))) (pop-directory) result))))) ;; Do not rpc this one, do the underlying calls!!! (define (tests:test-set-status! run-id test-id state status comment dat #!key (work-area #f)) (let* ((real-status status) (otherdat (if dat dat (make-hash-table))) (testdat (rmt:get-test-info-by-id run-id test-id)) (test-name (db:test-get-testname testdat)) (item-path (db:test-get-item-path testdat)) |
︙ | ︙ | |||
394 395 396 397 398 399 400 | (set! real-status "WAIVED")) (debug:print 4 *default-log-port* "real-status " real-status ", waived " waived ", status " status) ;; update the primary record IF state AND status are defined (if (and state status) (begin | | | | 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 | (set! real-status "WAIVED")) (debug:print 4 *default-log-port* "real-status " real-status ", waived " waived ", status " status) ;; update the primary record IF state AND status are defined (if (and state status) (begin (rmt:test-set-state-status run-id test-id state real-status (if waived waived comment)) ;; (mt:process-triggers run-id test-id state real-status) ;; triggers are called in test-set-state-status )) ;; if status is "AUTO" then call rollup (note, this one modifies data in test ;; run area, it does remote calls under the hood. ;; (if (and test-id state status (equal? status "AUTO")) ;; (rmt:test-data-rollup run-id test-id status)) |
︙ | ︙ | |||
480 481 482 483 484 485 486 | (let ((my-start-time (current-seconds)) (lockf (conc outputfilename ".lock"))) (let loop ((have-lock (common:simple-file-lock lockf))) (if have-lock (let ((script (configf:lookup *configdat* "testrollup" test-name))) (print "Obtained lock for " outputfilename) (rmt:roll-up-pass-fail-counts run-id test-name "" #f #f #f) | < | 475 476 477 478 479 480 481 482 483 484 485 486 487 488 | (let ((my-start-time (current-seconds)) (lockf (conc outputfilename ".lock"))) (let loop ((have-lock (common:simple-file-lock lockf))) (if have-lock (let ((script (configf:lookup *configdat* "testrollup" test-name))) (print "Obtained lock for " outputfilename) (rmt:roll-up-pass-fail-counts run-id test-name "" #f #f #f) (if script (system (conc script " > " outputfilename " & ")) (tests:generate-html-summary-for-iterated-test run-id test-id test-name outputfilename)) (common:simple-file-release-lock lockf) (change-directory orig-dir) ;; NB// tests:test-set-toplog! is remote internal... (tests:test-set-toplog! run-id test-name outputfilename)) |
︙ | ︙ |