Overview
Comment: | wip |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.70-nohomehost |
Files: | files | file ages | folders |
SHA1: |
87b6d8cf0ee30adeede40cc35530519b |
User & Date: | matt on 2022-11-13 04:53:25 |
Other Links: | branch diff | manifest | tags |
Context
2022-11-20
| ||
19:44 | Pulled in latest changes from v1.70 check-in: e966c3ef7e user: matt tags: v1.70-nohomehost | |
2022-11-13
| ||
04:53 | wip check-in: 87b6d8cf0e user: matt tags: v1.70-nohomehost | |
2022-11-12
| ||
19:25 | Most routines needed for no-homehost updated. check-in: ed25403d77 user: matt tags: v1.70-nohomehost | |
Changes
Modified archive.scm from [5c03589f24] to [25e6383e3d].
︙ | |||
344 345 346 347 348 349 350 | 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 | - + | (archiver (let ((s (configf:lookup *configdat* "archive" "archiver"))) (if s (string->symbol s) 'bup))) (rsync-exe (or (configf:lookup *configdat* "archive" "rsync") "rsync")) (print-prefix "Running: ") (archive-info (archive:allocate-new-archive-block blockid-cache *toppath* tsname min-space target-patt run-patt "megatest-db")) (archive-dir (if archive-info (cdr archive-info) #f)) (archive-id (if archive-info (car archive-info) -1)) |
︙ |
Modified client.scm from [17a8862d81] to [e699a8b092].
︙ | |||
87 88 89 90 91 92 93 | 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 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 | - + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + | (begin (debug:print-error 0 *default-log-port* "failed to start or connect to server") (exit 1)) ;; ;; Alternatively here, we can get the list of candidate servers and work our way ;; through them searching for a good one. ;; |
Modified common.scm from [c4aca77534] to [c81106d159].
︙ | |||
314 315 316 317 318 319 320 | 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 | - + + | ((skip) "SKIP") (else "FAIL"))) (define (common:logpro-exit-code->test-status exit-code) (status-sym->string (common:logpro-exit-code->status-sym exit-code))) (defstruct remote |
︙ | |||
1986 1987 1988 1989 1990 1991 1992 | 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 | - + | (host-last-used-set! rec curr-time) new-best) (if (null? tal) #f (loop (car tal)(cdr tal) best-host))))))))) (define (common:wait-for-homehost-load maxnormload msg) (let* ((hh-dat (if (common:on-homehost?) ;; if we are on the homehost then pass in #f so the calls are local. #f |
︙ |
Modified dashboard.scm from [d1f71cff63] to [47d443cd41].
︙ | |||
3806 3807 3808 3809 3810 3811 3812 | 3806 3807 3808 3809 3810 3811 3812 3813 3814 3815 3816 3817 3818 3819 3820 | - + | (if (not (launch:setup)) (begin (debug:print 0 *default-log-port* "Failed to find megatest.config, exiting") (exit 1) ) ) |
︙ |
Modified launch.scm from [56e9ef9407] to [9881087e2c].
︙ | |||
1561 1562 1563 1564 1565 1566 1567 | 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 | - + | (set! cmdparms (base64:base64-encode (z3:encode-buffer (with-output-to-string (lambda () ;; (list 'hosts hosts) (write (list (list 'testpath test-path) ;; (list 'transport (conc *transport-type*)) ;; (list 'serverinf *server-info*) |
︙ |
Modified megatest.scm from [b4770c25e0] to [b216f35a15].
︙ | |||
656 657 658 659 660 661 662 | 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 | - + | (if (args:any? "-run" "-runall" "-remove-runs" "-set-state-status" "-kill-runs" "-kill-rerun") (debug:print 0 *default-log-port* (string-intersperse (argv) " "))) ;; some switches imply homehost. Exit here if not on homehost ;; (let ((homehost-required (list "-cleanup-db"))) (if (apply args:any? homehost-required) |
︙ | |||
2377 2378 2379 2380 2381 2382 2383 | 2377 2378 2379 2380 2381 2382 2383 2384 2385 2386 2387 2388 2389 2390 2391 | - + | (exit 0))) (if (or (getenv "MT_RUNSCRIPT") (args:get-arg "-repl") (args:get-arg "-load")) (let* ((toppath (launch:setup)) (dbstructs (if (and toppath |
︙ |
Modified rmt.scm from [a7494b375d] to [d9f771a22a].
︙ | |||
114 115 116 117 118 119 120 | 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 | + - + | ;; DOT SET_HOMEHOST; // leaving off - doesn't really add to the clarity ;; DOT MUTEXLOCK -> SET_HOMEHOST [label="no homehost?"]; ;; DOT SET_HOMEHOST -> MUTEXLOCK; ;; ensure we have a homehost record (if (not (pair? (remote-hh-dat runremote))) ;; not on homehost (thread-sleep! 0.1) ;; since we shouldn't get here, delay a little (let ((hh-data (server:choose-server areapath 'homehost))) |
︙ |
Modified server.scm from [2c6bceea6f] to [237780917f].
︙ | |||
119 120 121 122 123 124 125 | 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | - + - - - - + + + + + - - - + + + - - - - - - - - - + + + + + + + + + - + | ;; Given an area path, start a server process ### NOTE ### > file 2>&1 ;; if the target-host is set ;; try running on that host ;; incidental: rotate logs in logs/ dir. ;; (define (server:run areapath) ;; areapath is *toppath* for a given testsuite area |
︙ | |||
452 453 454 455 456 457 458 | 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 | - + + + + + + + + - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - | (equal? host (list-ref (hash-table-ref serversdat x) 0))) by-time-asc)) (best-five (lambda () (if (> (length all-valid) 5) (map (lambda (x) (hash-table-ref serversdat x)) (take all-valid 5)) |
︙ | |||
543 544 545 546 547 548 549 | 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 | - + | (try-num 0)) (if (or server-info (> (current-seconds) give-up-time)) ;; server-url will be #f if no server available. (server:record->url server-info) (let ((num-ok (length (server:choose-server areapath 'all-valid)))) (if (and (> try-num 0) ;; first time through simply wait a little while then try again (< num-ok 1)) ;; if there are no decent candidates for servers then try starting a new one |
︙ |