Overview
| Comment: | Changed get-cpu-load to commonmod:get-cpu-load in tests.scm |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.80-revolution |
| Files: | files | file ages | folders |
| SHA1: |
59391382436b47328a589fc31df55f42 |
| User & Date: | mmgraham on 2024-01-23 18:57:26 |
| Other Links: | branch diff | manifest | tags |
Context
|
2024-01-26
| ||
| 09:43 | Deal better with malformed .final-status files check-in: ddf07290ee user: mrwellan tags: v1.80-revolution | |
|
2024-01-23
| ||
| 18:57 | Changed get-cpu-load to commonmod:get-cpu-load in tests.scm check-in: 5939138243 user: mmgraham tags: v1.80-revolution | |
| 13:49 | Fixed gen testfiles check-in: 03b0bd0cd4 user: mrwellan tags: v1.80-revolution | |
Changes
Modified common.scm from [32dd65dc5b] to [1accdc4178].
| ︙ | ︙ | |||
1659 1660 1661 1662 1663 1664 1665 | ;; (let ((newval (string->number (cadr match)))) ;; (if (number? newval) ;; (set! cpu-load newval)))))) ;; (car load-res)) ;; cpu-load)) ;;====================================================================== | | | | 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673 1674 1675 1676 1677 1678 1679 1680 |
;; (let ((newval (string->number (cadr match))))
;; (if (number? newval)
;; (set! cpu-load newval))))))
;; (car load-res))
;; cpu-load))
;;======================================================================
;; get values from cached info from dropping file in .sysdata dir
;; e.g. key is host and dtype is normalized-load
;;
(define (common:get-cached-info key dtype #!key (age 10))
(if *toppath*
(let* ((fullpath (conc *toppath* "/.sysdata/" key "-" dtype ".log"))
(delfile (lambda (exn)
(debug:print-info 2 *default-log-port* " removing bad file " fullpath ", exn=" exn)
(delete-file* fullpath)
#f)))
(if (and (file-exists? fullpath)
(file-read-access? fullpath))
(handle-exceptions
exn
(begin
|
| ︙ | ︙ |
Modified tcp-transportmod.scm from [312708d26e] to [0cd20b4ff2].
| ︙ | ︙ | |||
417 418 419 420 421 422 423 | (if (> adj wait-delay) 0 (- wait-delay adj)) 0))) (if (> new-wait 0) (begin (if (common:low-noise-print 10 "delay wait message") | | | | 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 | (if (> adj wait-delay) 0 (- wait-delay adj)) 0))) (if (> new-wait 0) (begin (if (common:low-noise-print 10 "delay wait message") (debug:print-info 0 *default-log-port* "Server on host " host " loaded, DelayWait: "new-wait)) (tt:backoff-wait-delay-set! bkoff new-wait) (tt:backoff-last-adj-t-set! bkoff (current-seconds)) (thread-sleep! new-wait)) (hash-table-delete! *tt:backoff-smoothing* host-port)))))) (define (tt:send-receive-direct host port dat #!key (ping-mode #f)(tries-remaining 25)) (assert (number? port) "FATAL: tt:send-receive-direct called with a port that is not a number "port) (tt:backoff-decr-and-wait host port) (let* ((retry (lambda () (tt:send-receive-direct host port dat tries-remaining: (- tries-remaining 1)))) (full-err-print (lambda (exn msg) (if (condition? exn) (begin (pp (condition->list exn) *default-log-port*) |
| ︙ | ︙ |
Modified tests.scm from [97b0ba1ab3] to [776a2ca8e7].
| ︙ | ︙ | |||
1992 1993 1994 1995 1996 1997 1998 |
(if (and uname hostname)
(rmt:general-call 'update-uname-host run-id uname hostname test-id)))
;; This one is for running with no db access (i.e. via rmt: internally)
(define (tests:set-full-meta-info db test-id run-id minutes work-area remtries)
;; (define (tests:set-full-meta-info test-id run-id minutes work-area)
;; (let ((remtries 10))
| | | 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 |
(if (and uname hostname)
(rmt:general-call 'update-uname-host run-id uname hostname test-id)))
;; This one is for running with no db access (i.e. via rmt: internally)
(define (tests:set-full-meta-info db test-id run-id minutes work-area remtries)
;; (define (tests:set-full-meta-info test-id run-id minutes work-area)
;; (let ((remtries 10))
(let* ((cpuload (commonmod:get-cpu-load))
(diskfree (get-df (current-directory)))
(uname (get-uname "-srvpio"))
(hostname (get-host-name)))
(tests:update-central-meta-info run-id test-id cpuload diskfree minutes uname hostname)))
;; (define (tests:set-partial-meta-info test-id run-id minutes work-area)
#;(define (tests:set-partial-meta-info test-id run-id minutes work-area remtries)
|
| ︙ | ︙ |