Overview
| Comment: | Tweaks for server mode |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | servermode |
| Files: | files | file ages | folders |
| SHA1: |
e51571f4ffc86e2251a264d3becc65d3 |
| User & Date: | matt on 2012-03-11 20:01:03 |
| Other Links: | branch diff | manifest | tags |
Context
|
2012-03-11
| ||
| 20:59 | Minor tweaks that may help server mode check-in: 40b4f08239 user: matt tags: servermode | |
| 20:01 | Tweaks for server mode check-in: e51571f4ff user: matt tags: servermode | |
| 18:33 | Many tweaks for server mode check-in: a941b43e91 user: matt tags: servermode | |
Changes
Modified megatest.scm from [cba9eecfc2] to [2d88d422bf].
| ︙ | ︙ | |||
338 339 340 341 342 343 344 |
(if (and (args:get-arg "-server")
(not (or (args:get-arg "-runall")
(args:get-arg "-runtests"))))
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(debug:print 0 "INFO: Starting the standalone server")
(if db
| | | | | 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 |
(if (and (args:get-arg "-server")
(not (or (args:get-arg "-runall")
(args:get-arg "-runtests"))))
(let* ((toppath (setup-for-run))
(db (if toppath (open-db) #f)))
(debug:print 0 "INFO: Starting the standalone server")
(if db
(let* ((host:port (db:get-var db "SERVER")) ;; this doen't support multiple servers BUG!!!!
(th2 (server:start db (args:get-arg "-server")))
(th3 (make-thread (lambda ()
(server:keep-running db)))))
(thread-start! th3)
(thread-join! th3))
(debug:print 0 "ERROR: Failed to setup for megatest"))))
;;======================================================================
;; full run
;;======================================================================
|
| ︙ | ︙ | |||
644 645 646 647 648 649 650 | (logfile (conc stepname ".log")) (cmd (if (null? remargs) #f (car remargs))) (params (if cmd (cdr remargs) '())) (exitstat #f) (shell (last (string-split (get-environment-variable "SHELL") "/"))) (redir (case (string->symbol shell) ((tcsh csh ksh) ">&") | | > | | | | > | | | | | 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 |
(logfile (conc stepname ".log"))
(cmd (if (null? remargs) #f (car remargs)))
(params (if cmd (cdr remargs) '()))
(exitstat #f)
(shell (last (string-split (get-environment-variable "SHELL") "/")))
(redir (case (string->symbol shell)
((tcsh csh ksh) ">&")
((zsh bash sh ash) "2>&1 >")
(else ">&")))
(fullcmd (conc "(" (string-intersperse
(cons cmd params) " ")
") " redir " " logfile)))
;; mark the start of the test
(rdb:teststep-set-status! db test-id stepname "start" "n/a" itemdat (args:get-arg "-m") logfile)
;; close the db
;; (sqlite3:finalize! db)
;; run the test step
(debug:print 2 "INFO: Running \"" fullcmd "\"")
(change-directory startingdir)
(set! exitstat (system fullcmd)) ;; cmd params))
(set! *globalexitstatus* exitstat)
(change-directory testpath)
;; re-open the db
;; (set! db (open-db))
;; (if (not (args:get-arg "-server"))
;; (server:client-setup db))
;; run logpro if applicable ;; (process-run "ls" (list "/foo" "2>&1" "blah.log"))
(if logprofile
(let* ((htmllogfile (conc stepname ".html"))
(oldexitstat exitstat)
(cmd (string-intersperse (list "logpro" logprofile htmllogfile "<" logfile ">" (conc stepname "_logpro.log")) " ")))
(debug:print 2 "INFO: running \"" cmd "\"")
(change-directory startingdir)
(set! exitstat (system cmd))
(set! *globalexitstatus* exitstat) ;; no necessary
(change-directory testpath)
(rdb:test-set-log! db test-id htmllogfile)))
(let ((msg (args:get-arg "-m")))
(rdb:teststep-set-status! db test-id stepname "end" exitstat itemdat msg logfile))
;; (sqlite3:finalize! db)
;;(if (not (eq? exitstat 0))
;; (exit 254)) ;; (exit exitstat) doesn't work?!?
;; open the db
;; mark the end of the test
)))
(if (or (args:get-arg "-test-status")
(args:get-arg "-set-values"))
(let ((newstatus (cond
((number? status) (if (equal? status 0) "PASS" "FAIL"))
|
| ︙ | ︙ |
Modified server.scm from [2c62a156d9] to [d8ddcb6ae7].
| ︙ | ︙ | |||
101 102 103 104 105 106 107 |
'rdb:test-set-comment
(lambda (run-id test-name item-path comment)
(set! *last-db-access* (current-seconds))
(db:test-set-comment db run-id test-name item-path comment)))
(rpc:publish-procedure!
'rdb:test-set-log!
| | | 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 |
'rdb:test-set-comment
(lambda (run-id test-name item-path comment)
(set! *last-db-access* (current-seconds))
(db:test-set-comment db run-id test-name item-path comment)))
(rpc:publish-procedure!
'rdb:test-set-log!
(lambda (test-id logf)
(set! *last-db-access* (current-seconds))
(db:test-set-log! db test-id logf)))
(rpc:publish-procedure!
'rdb:get-test-data-by-id
(lambda (test-id)
(set! *last-db-access* (current-seconds))
|
| ︙ | ︙ |