Overview
| Comment: | auto start of server improvements |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | trunk | v1.5209 |
| Files: | files | file ages | folders |
| SHA1: |
5e942a19b82e04db97c97bcbbf958cd2 |
| User & Date: | mrwellan on 2012-12-11 15:15:40 |
| Other Links: | manifest | tags |
Context
|
2012-12-12
| ||
| 21:25 | Fix for multiple return values from -test-paths check-in: 65e65c0318 user: mrwellan tags: trunk | |
|
2012-12-11
| ||
| 15:15 | auto start of server improvements check-in: 5e942a19b8 user: mrwellan tags: trunk, v1.5209 | |
| 13:24 | bumped version to v1.5208 check-in: 9164b06cdd user: mrwellan tags: trunk, v1.5208 | |
Changes
Modified megatest-version.scm from [b8951eab80] to [0f1fe6d977].
1 2 3 4 5 | ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two digit decimal ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.5209) |
Modified megatest.scm from [2bf02a0d8b] to [d00ef9a849].
| ︙ | ︙ | |||
344 345 346 347 348 349 350 |
;; Weird special calls that need to run *after* the server has started?
;;======================================================================
(if (args:get-arg "-list-targets")
(let ((targets (common:get-runconfig-targets)))
(print "Found "(length targets) " targets")
(for-each (lambda (x)
| | > | 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 |
;; Weird special calls that need to run *after* the server has started?
;;======================================================================
(if (args:get-arg "-list-targets")
(let ((targets (common:get-runconfig-targets)))
(print "Found "(length targets) " targets")
(for-each (lambda (x)
;; (print "[" x "]"))
(print x))
targets)
(set! *didsomething* #t)))
(if (args:get-arg "-show-runconfig")
(begin
(pp (hash-table->alist (open-run-close setup-env-defaults #f "runconfigs.config" #f #f change-env: #f)))
(set! *didsomething* #t)))
|
| ︙ | ︙ | |||
424 425 426 427 428 429 430 | (let ((targetstr (string-intersperse (map (lambda (x) (db:get-value-by-header run header x)) keynames) "/"))) (if db-targets (if (not (hash-table-ref/default seen targetstr #f)) (begin (hash-table-set! seen targetstr #t) | | > | 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 | (let ((targetstr (string-intersperse (map (lambda (x) (db:get-value-by-header run header x)) keynames) "/"))) (if db-targets (if (not (hash-table-ref/default seen targetstr #f)) (begin (hash-table-set! seen targetstr #t) ;; (print "[" targetstr "]")))) (print targetstr)))) (if (not db-targets) (let* ((run-id (open-run-close db:get-value-by-header run header "id")) (tests (open-run-close db:get-tests-for-run db run-id testpatt '() '()))) (debug:print 1 "Run: " targetstr " status: " (db:get-value-by-header run header "state") " run-id: " run-id ", number tests: " (length tests)) (for-each (lambda (test) |
| ︙ | ︙ | |||
905 906 907 908 909 910 911 |
(if (args:get-arg "-repl")
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(if db
(begin
(set! *db* db)
(set! *client-non-blocking-mode* #t)
| | | 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 |
(if (args:get-arg "-repl")
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(if db
(begin
(set! *db* db)
(set! *client-non-blocking-mode* #t)
(server:client-setup)
(import readline)
(import apropos)
(gnu-history-install-file-manager
(string-append
(or (get-environment-variable "HOME") ".") "/.megatest_history"))
(current-input-port (make-gnu-readline-port "megatest> "))
(repl))
|
| ︙ | ︙ |
Modified server.scm from [57a973d766] to [2caba19210].
| ︙ | ︙ | |||
328 329 330 331 332 333 334 335 336 337 338 339 340 341 | (let ((exe (car (argv))) (pid #f)) (debug:print-info 0 "No server available, attempting to start one...") ;; (set! pid (process-run exe (list "-server" "-" "-debug" (if (list? *verbosity*) ;; (string-intersperse *verbosity* ",") ;; (conc *verbosity*))))) (set! pid (process-fork (lambda () (server:launch)))) ;; should never get here .... (let loop ((count 0)) (let ((hostinfo (open-run-close tasks:get-best-server tasks:open-db))) (if (not hostinfo) (begin (debug:print-info 0 "Waiting for server pid=" pid " to start") (sleep 2) ;; give server time to start | > > > | 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 | (let ((exe (car (argv))) (pid #f)) (debug:print-info 0 "No server available, attempting to start one...") ;; (set! pid (process-run exe (list "-server" "-" "-debug" (if (list? *verbosity*) ;; (string-intersperse *verbosity* ",") ;; (conc *verbosity*))))) (set! pid (process-fork (lambda () ;; (current-input-port (open-input-file "/dev/null")) ;; (current-output-port (open-output-file "/dev/null")) ;; (current-error-port (open-output-file "/dev/null")) (server:launch)))) ;; should never get here .... (let loop ((count 0)) (let ((hostinfo (open-run-close tasks:get-best-server tasks:open-db))) (if (not hostinfo) (begin (debug:print-info 0 "Waiting for server pid=" pid " to start") (sleep 2) ;; give server time to start |
| ︙ | ︙ |