Megatest

Check-in [35909bedef]
Login
Overview
Comment:Fixed couple problems with tasks_queue migration
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | archiving
Files: files | file ages | folders
SHA1: 35909bedefbfe5266d84b987fcb59bf0ecc6f247
User & Date: matt on 2014-11-30 22:55:57
Other Links: branch diff | manifest | tags
Context
2014-12-02
21:10
Merged in multi-transport changes check-in: b85b307ce3 user: matt tags: archiving
15:40
Partial transition to ongoing init of db's Closed-Leaf check-in: afe4ca4f8f user: mrwellan tags: archiving-db-init
2014-11-30
22:55
Fixed couple problems with tasks_queue migration check-in: 35909bedef user: matt tags: archiving
22:30
Moved tasks_queue into main.db check-in: 5af4229eb4 user: matt tags: archiving
Changes

Modified rmt.scm from [bd81b52c68] to [8a741ef8fc].

582
583
584
585
586
587
588
589

590
582
583
584
585
586
587
588

589
590







-
+


(define (rmt:tasks-find-task-queue-records target run-name test-patt state-patt action-patt)
  (rmt:send-receive 'find-task-queue-records #f (list target run-name test-patt state-patt action-patt)))

(define (rmt:tasks-add action owner target runname testpatt params)
  (rmt:send-receive 'tasks-add #f (list action owner target runname testpatt params)))

(define (rmt:tasks-set-state-given-param-key dbstruct param-key new-state)
(define (rmt:tasks-set-state-given-param-key param-key new-state)
  (rmt:send-receive 'tasks-set-state-given-param-key #f (list  param-key new-state)))

Modified runs.scm from [22b3739b80] to [13fbbb587f].

221
222
223
224
225
226
227
228

229
230
231
232
233
234

235
236
237
238
239
240
241
221
222
223
224
225
226
227

228
229
230
231
232
233

234
235
236
237
238
239
240
241







-
+





-
+







    (if (tasks:need-server run-id)(tasks:start-and-wait-for-server tdbdat run-id 10))

    (set-signal-handler! signal/int
			 (lambda (signum)
			   (signal-mask! signum)
			   (print "Received signal " signum ", cleaning up before exit. Please wait...")
			   (let ((tdbdat (tasks:open-db)))
			     (tasks:set-state-given-param-key (db:delay-if-busy tdbdat) task-key "killed"))
			     (rmt:tasks-set-state-given-param-key task-key "killed"))
			   (print "Killed by signal " signum ". Exiting")
			   (exit)))

    ;; register this run in monitor.db
    (rmt:tasks-add "run-tests" user target runname test-patts task-key) ;; params)
    (rmt:tasks-set-state-given-param-key (db:delay-if-busy tdbdat) task-key "running")
    (rmt:tasks-set-state-given-param-key task-key "running")
    (runs:set-megatest-env-vars run-id inkeys: keys inrunname: runname) ;; these may be needed by the launching process
    (if (file-exists? runconfigf)
	(setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keyvals target)
	(debug:print 0 "WARNING: You do not have a run config file: " runconfigf))

    ;; Now generate all the tests lists
    (set! all-tests-registry (tests:get-all))

Modified tasks.scm from [a07c5a816e] to [5a8685d04c].

720
721
722
723
724
725
726
727

728
729
730
731
732
733
734
720
721
722
723
724
725
726

727
728
729
730
731
732
733
734







-
+







    res)) ;; )

;; kill any runner processes (i.e. processes handling -runtests) that match target/runname
;; 
;; do a remote call to get the task queue info but do the killing as self here.
;;
(define (tasks:kill-runner target run-name)
  (let ((records    (rmt:find-task-queue-records target run-name "%" "running" "run-tests"))
  (let ((records    (rmt:tasks-find-task-queue-records target run-name "%" "running" "run-tests"))
	(hostpid-rx (regexp "\\s+(\\w+)\\s+(\\d+)$"))) ;; host pid is at end of param string
    (if (null? records)
	(debug:print 0 "No run launching processes found for " target " / " run-name)
	(debug:print 0 "Found " (length records) " run(s) to kill."))
    (for-each 
     (lambda (record)
       (let* ((param-key (list-ref record 8))