Changes In Branch network-only-transport Through [c6cee5cbb1] Excluding Merge-Ins
This is equivalent to a diff from b93e6887b8 to c6cee5cbb1
2013-03-06
| ||
15:38 | Merged network-only-transport and bumped version to v1.53 check-in: 962322e080 user: mrwellan tags: trunk, v1.53 | |
2013-03-04
| ||
22:27 | Disabled fs and got zmq working again (I think) check-in: 9bf6d9d0fe user: matt tags: network-only-transport | |
2013-02-28
| ||
23:28 | Converted couple more calls in runs.scm to full remote check-in: c6cee5cbb1 user: matt tags: network-only-transport | |
23:08 | Converted dashboard to remote calls check-in: c1e7692bac user: matt tags: network-only-transport | |
16:40 | Removed all traces of itempath check-in: b93e6887b8 user: mrwellan tags: trunk | |
2013-02-26
| ||
22:18 | Added server start to Makefile check-in: c4982d7367 user: matt tags: trunk | |
Modified dashboard.scm from [9fce501c6a] to [6cbe46c740].
︙ | ︙ | |||
54 55 56 57 58 59 60 | ;; process args (define remargs (args:get-args (argv) (list "-rows" "-run" "-test" "-debug" | | | 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | ;; process args (define remargs (args:get-args (argv) (list "-rows" "-run" "-test" "-debug" "-host" ) (list "-h" "-guimonitor" "-main" "-v" "-q" ) |
︙ | ︙ | |||
77 78 79 80 81 82 83 | (if (not (setup-for-run)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) (define *db* #f) ;; (open-db)) | | | | > | > | | 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 | (if (not (setup-for-run)) (begin (print "Failed to find megatest.config, exiting") (exit 1))) (define *db* #f) ;; (open-db)) (if (args:get-arg "-host") (begin (set! *runremote* (string-split (args:get-arg "-host" ":"))) (server:client-launch)) (server:client-launch)) ;; HACK ALERT: this is a hack, please fix. (define *read-only* (not (file-read-access? (conc *toppath* "/megatest.db")))) ;; (server:client-setup *db*) (define toplevel #f) (define dlg #f) (define max-test-num 0) ;; (define *keys* (open-run-close db:get-keys #f)) (define *keys* (cdb:remote-run db:get-keys #f)) ;; (define *keys* (db:get-keys *db*)) (define *dbkeys* (map (lambda (x)(vector-ref x 0)) (append *keys* (list (vector "runname" "blah"))))) (define *header* #f) (define *allruns* '()) (define *buttondat* (make-hash-table)) ;; <run-id color text test run-key> (define *alltestnamelst* '()) (define *searchpatts* (make-hash-table)) (define *num-runs* 8) (define *tot-run-count* (cdb:remote-run db:get-num-runs #f "%")) ;; (define *tot-run-count* (db:get-num-runs *db* "%")) (define *last-update* (current-seconds)) (define *num-tests* 15) (define *start-run-offset* 0) (define *start-test-offset* 0) (define *examine-test-dat* (make-hash-table)) (define *exit-started* #f) |
︙ | ︙ | |||
167 168 169 170 171 172 173 | (> (current-seconds)(+ *last-db-update-time* 5))) (> *delayed-update* 0)) (begin (debug:print-info 4 "update-rundat runnamepatt: " runnamepatt " numruns: " numruns " testnamepatt: " testnamepatt " keypatts: " keypatts) (set! *please-update-buttons* #t) (set! *last-db-update-time* modtime) (set! *delayed-update* (- *delayed-update* 1)) | | | | | 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 | (> (current-seconds)(+ *last-db-update-time* 5))) (> *delayed-update* 0)) (begin (debug:print-info 4 "update-rundat runnamepatt: " runnamepatt " numruns: " numruns " testnamepatt: " testnamepatt " keypatts: " keypatts) (set! *please-update-buttons* #t) (set! *last-db-update-time* modtime) (set! *delayed-update* (- *delayed-update* 1)) (let* ((allruns (cdb:remote-run db:get-runs #f runnamepatt numruns ;; (+ numruns 1) ;; (/ numruns 2)) *start-run-offset* keypatts)) (header (db:get-header allruns)) (runs (db:get-rows allruns)) (result '()) (maxtests 0) (states (hash-table-keys *state-ignore-hash*)) (statuses (hash-table-keys *status-ignore-hash*))) ;; (thread-sleep! 0.1) ;; give some time to other threads (debug:print 6 "update-rundat, got " (length runs) " runs") (if (> (+ *last-update* 300) (current-seconds)) ;; every five minutes (begin (set! *last-update* (current-seconds)) (set! *tot-run-count* (length runs)))) ;; (rdb:get-num-runs *db* runnamepatt)))) (for-each (lambda (run) (let* ((run-id (db:get-value-by-header run header "id")) (tests (let ((tsts (cdb:remote-run db:get-tests-for-run #f run-id testnamepatt states statuses))) (if *tests-sort-reverse* (reverse tsts) tsts))) (key-vals (cdb:remote-run db:get-key-vals #f run-id))) (if (> (length tests) maxtests) (set! maxtests (length tests))) (if (or (not *hide-empty-runs*) ;; this reduces the data burden when set (not (null? tests))) (set! result (cons (vector run tests key-vals) result))))) runs) (set! *header* header) |
︙ | ︙ | |||
641 642 643 644 645 646 647 | ((args:get-arg "-run") (let ((runid (string->number (args:get-arg "-run")))) (if runid (begin (lambda (x) (on-exit (lambda () (if *db* (sqlite3:finalize! *db*)))) | | | 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 | ((args:get-arg "-run") (let ((runid (string->number (args:get-arg "-run")))) (if runid (begin (lambda (x) (on-exit (lambda () (if *db* (sqlite3:finalize! *db*)))) (cdb:remote-run examine-run *db* runid))) (begin (print "ERROR: runid is not a number " (args:get-arg "-run")) (exit 1))))) ((args:get-arg "-test") (let ((testid (string->number (args:get-arg "-test")))) (if testid (examine-test testid) |
︙ | ︙ |
Modified launch.scm from [9c1957ce23] to [9d5e223a7b].
︙ | ︙ | |||
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | (target (assoc/default 'target cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) (env-ovrd (assoc/default 'env-ovrd cmdinfo)) (set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar (runname (assoc/default 'runname cmdinfo)) (megatest (assoc/default 'megatest cmdinfo)) (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo)) (fullrunscript (if (not runscript) #f (if (substring-index "/" runscript) runscript ;; use unadultered if contains slashes (let ((fulln (conc testpath "/" runscript))) (if (and (file-exists? fulln) (file-execute-access? fulln)) fulln runscript))))) ;; assume it is on the path (rollup-status 0)) (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) ;; Setup the *runremote* global var (if *runremote* (debug:print 2 "ERROR: I'm not expecting *runremote* to be set at this time")) (set! *runremote* runremote) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) (let ((varpairs (string-split set-vars ","))) (debug:print 4 "varpairs: " varpairs) (map (lambda (varpair) (let ((varval (string-split varpair "="))) | > > > > | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 | (target (assoc/default 'target cmdinfo)) (itemdat (assoc/default 'itemdat cmdinfo)) (env-ovrd (assoc/default 'env-ovrd cmdinfo)) (set-vars (assoc/default 'set-vars cmdinfo)) ;; pre-overrides from -setvar (runname (assoc/default 'runname cmdinfo)) (megatest (assoc/default 'megatest cmdinfo)) (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo)) (keys #f) (keyvals #f) (fullrunscript (if (not runscript) #f (if (substring-index "/" runscript) runscript ;; use unadultered if contains slashes (let ((fulln (conc testpath "/" runscript))) (if (and (file-exists? fulln) (file-execute-access? fulln)) fulln runscript))))) ;; assume it is on the path (rollup-status 0)) (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name)) ;; Setup the *runremote* global var (if *runremote* (debug:print 2 "ERROR: I'm not expecting *runremote* to be set at this time")) (set! *runremote* runremote) (set! keys (cdb:remote-run db:get-keys #f)) (set! keyvals (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f)) ;; apply pre-overrides before other variables. The pre-override vars must not ;; clobbers things from the official sources such as megatest.config and runconfigs.config (if (string? set-vars) (let ((varpairs (string-split set-vars ","))) (debug:print 4 "varpairs: " varpairs) (map (lambda (varpair) (let ((varval (string-split varpair "="))) |
︙ | ︙ | |||
115 116 117 118 119 120 121 | ;; Can setup as client for server mode now (server:client-setup) (change-directory *toppath*) (set-megatest-env-vars run-id) ;; these may be needed by the launching process (change-directory work-area) | | | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 | ;; Can setup as client for server mode now (server:client-setup) (change-directory *toppath*) (set-megatest-env-vars run-id) ;; these may be needed by the launching process (change-directory work-area) (open-run-close set-run-config-vars #f run-id keys keyvals) ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) (set-megatest-env-vars run-id) (set-item-env-vars itemdat) (save-environment-as-files "megatest") (open-run-close test-set-meta-info #f test-id run-id test-name itemdat 0) (tests:test-set-status! test-id "REMOTEHOSTSTART" "n/a" (args:get-arg "-m") #f) |
︙ | ︙ |
Modified runconfig.scm from [e60c2bb3c8] to [09fb252607].
︙ | ︙ | |||
8 9 10 11 12 13 14 | (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") | | > | | | 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | (declare (unit runconfig)) (declare (uses common)) (include "common_records.scm") ;; (define (setup-env-defaults db fname run-id already-seen #!key (environ-patt #f)(change-env #t)) (define (setup-env-defaults fname run-id already-seen keys keyvals #!key (environ-patt #f)(change-env #t)) (let* (;; (keys (db:get-keys db)) ;; (keyvals (if run-id (db:get-key-vals db run-id) #f)) (thekey (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) keyvals) "/") (if (args:get-arg "-reqtarg") (args:get-arg "-reqtarg") (if (args:get-arg "-target") (args:get-arg "-target") (begin (debug:print 0 "ERROR: setup-env-defaults called with no run-id or -target or -reqtarg") |
︙ | ︙ | |||
56 57 58 59 60 61 62 | (for-each (lambda (fullkey) (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))) sections) (debug:print 2 "---") (set! *already-seen-runconfig-info* #t))) finaldat)) | | > | | | | | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 | (for-each (lambda (fullkey) (debug:print 2 (format #f "~20a ~a\n" fullkey (hash-table-ref/default whatfound fullkey 0)))) sections) (debug:print 2 "---") (set! *already-seen-runconfig-info* #t))) finaldat)) (define (set-run-config-vars db run-id keys keyvals) (let ((runconfigf (conc *toppath* "/runconfigs.config")) (targ (or (args:get-arg "-target") (args:get-arg "-reqtarg") (db:get-target db run-id)))) (if (file-exists? runconfigf) (setup-env-defaults runconfigf run-id #t keys keyvals environ-patt: (conc "(default" (if targ (conc "|" targ ")") ")"))) (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)))) |
Modified runs.scm from [1aa6b158e4] to [7ba96bae1f].
︙ | ︙ | |||
213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 | ;; (define (runs:run-tests target runname test-names test-patts user flags) (common:clear-caches) ;; clear all caches (let* ((db #f) (keys (cdb:remote-run db:get-keys #f)) (keyvallst (keys:target->keyval keys target)) (run-id (cdb:remote-run runs:register-run #f keys keyvallst runname "new" "n/a" user)) ;; test-name))) (deferred '()) ;; delay running these since they have a waiton clause ;; keepgoing is the defacto modality now, will add hit-n-run a bit later ;; (keepgoing (hash-table-ref/default flags "-keepgoing" #f)) (runconfigf (conc *toppath* "/runconfigs.config")) (required-tests '()) (test-records (make-hash-table))) (set-megatest-env-vars run-id) ;; these may be needed by the launching process (if (file-exists? runconfigf) | > | | 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 | ;; (define (runs:run-tests target runname test-names test-patts user flags) (common:clear-caches) ;; clear all caches (let* ((db #f) (keys (cdb:remote-run db:get-keys #f)) (keyvallst (keys:target->keyval keys target)) (run-id (cdb:remote-run runs:register-run #f keys keyvallst runname "new" "n/a" user)) ;; test-name))) (keyvals (if run-id (cdb:remote-run db:get-key-vals #f run-id) #f)) (deferred '()) ;; delay running these since they have a waiton clause ;; keepgoing is the defacto modality now, will add hit-n-run a bit later ;; (keepgoing (hash-table-ref/default flags "-keepgoing" #f)) (runconfigf (conc *toppath* "/runconfigs.config")) (required-tests '()) (test-records (make-hash-table))) (set-megatest-env-vars run-id) ;; these may be needed by the launching process (if (file-exists? runconfigf) (setup-env-defaults runconfigf run-id *already-seen-runconfig-info* keys keyvals "pre-launch-env-vars") (debug:print 0 "WARNING: You do not have a run config file: " runconfigf)) ;; look up all tests matching the comma separated list of globs in ;; test-patts (using % as wildcard) (set! test-names (tests:get-valid-tests *toppath* test-names)) (set! test-names (delete-duplicates test-names)) |
︙ | ︙ |