Megatest

Check-in [5939138243]
Login
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: 59391382436b47328a589fc31df55f42cb373407
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
1666

1667
1668
1669
1670
1671
1672
1673

1674
1675
1676
1677
1678
1679
1680
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 logs dir
;; 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 1 *default-log-port* " removing bad file " fullpath ", exn=" 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
424

425
426
427
428
429
430
431

432
433
434
435
436
437
438
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 loaded, DelayWait: "new-wait))
		    (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 port not a number "port)
  (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
1999

2000
2001
2002
2003
2004
2005
2006
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  (get-cpu-load))
  (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)