Megatest

Check-in [49e3e23dda]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Tidy output on server timeout. Add exception handler on evaluating variables in the shell
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: 49e3e23dda3601f2714e1dad935688a52392197e
User & Date: mrwellan on 2015-10-27 12:28:19
Other Links: branch diff | manifest | tags
Context
2015-11-02
08:04
More robust handling of rget when dependent vars do not exist. Minor output cleanup check-in: e1476e429d user: mrwellan tags: v1.60
2015-10-27
12:28
Tidy output on server timeout. Add exception handler on evaluating variables in the shell check-in: 49e3e23dda user: mrwellan tags: v1.60
11:05
oops. missed the logs part of the file names ... check-in: 56f19e80ce user: mrwellan tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified configf.scm from [c70b933712] to [b1cdc5542b].

︙
41
42
43
44
45
46
47





48
49
50



51
52
53
54
55
56
57

41
42
43
44
45
46
47
48
49
50
51
52



53
54
55
56
57
58
59
60
61
62








+
+
+
+
+
-
-
-
+
+
+








(define (config:assoc-safe-add alist key val #!key (metadata #f))
  (let ((newalist (filter (lambda (x)(not (equal? key (car x)))) alist)))
    (append newalist (list (if metadata
			       (list key val metadata)
			       (list key val))))))

(define (config:eval-string-in-environment str)
  (handle-exceptions
   exn
   (begin
     (debug:print 0 "ERROR: problem evaluating \"" str "\" in the shell environment")
     #f)
  (let ((cmdres (cmd-run->list (conc "echo " str))))
    (if (null? cmdres) ""
	(caar cmdres))))
   (let ((cmdres (cmd-run->list (conc "echo " str))))
     (if (null? cmdres) ""
	 (caar cmdres)))))

;;======================================================================
;; Make the regexp's needed globally available
;;======================================================================

(define configf:include-rx (regexp "^\\[include\\s+(.*)\\]\\s*$"))
(define configf:section-rx (regexp "^\\[(.*)\\]\\s*$"))
︙

Modified http-transport.scm from [96dc217b5c] to [d387fec12a].

︙
457
458
459
460
461
462
463
464

465
466
467
468

469
470
471
472
473
474
475

457
458
459
460
461
462
463

464
465
466
467

468
469
470
471
472
473
474
475








-
+



-
+








      (set! last-access *last-db-access*)
      (mutex-unlock! *heartbeat-mutex*)

      ;; (debug:print 11 "last-access=" last-access ", server-timeout=" server-timeout)
      ;;
      ;; no_traffic, no running tests, if server 0, no running servers
      ;;
      ;; (let ((wait-on-running (configf:lookup *configdat* "server" "wait-on-running"))) ;; wait on running tasks (if not true then exit on time out)
      ;; (let ((wait-on-running (configf:lookup *configdat* "server" b"wait-on-running"))) ;; wait on running tasks (if not true then exit on time out)
      ;;
      (let* ((hrs-since-start  (/ (- (current-seconds) server-start-time) 3600))
	     (adjusted-timeout (if (> hrs-since-start 1)
				   (- server-timeout (* hrs-since-start 60))  ;; subtract 60 seconds per hour
				   (- server-timeout (inexact->exact (round (* hrs-since-start 60))))  ;; subtract 60 seconds per hour
				   server-timeout)))
	(if (common:low-noise-print 120 "server timeout")
	    (debug:print-info 0 "Adjusted server timeout: " adjusted-timeout))
	(if (and *server-run*
		 (> (+ last-access server-timeout)
		    (current-seconds)))
	    (begin
︙

This page was generated in about 0.11s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00