Overview
| Comment: | More robust handling of rget when dependent vars do not exist. Minor output cleanup |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.60 |
| Files: | files | file ages | folders |
| SHA1: |
e1476e429dade79f033186f28cd6977c |
| User & Date: | mrwellan on 2015-11-02 08:04:35 |
| Other Links: | branch diff | manifest | tags |
Context
|
2015-11-02
| ||
| 09:36 | Don't updated stored cpu/disk space unless changed more than 200 Meg or .6 load check-in: c7ef1b27a4 user: mrwellan tags: v1.60 | |
| 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 | |
Changes
Modified common.scm from [6d58f78d86] to [1ec3dc239a].
| ︙ | ︙ | |||
395 396 397 398 399 400 401 |
res)
#t))
;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t))))
(define (common:get-runconfig-targets #!key (configf #f))
(sort (map car (hash-table->alist
(or configf
| | | > | 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 |
res)
#t))
;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t))))
(define (common:get-runconfig-targets #!key (configf #f))
(sort (map car (hash-table->alist
(or configf
(read-config (conc *toppath* "/runconfigs.config")
#f #t)
(make-hash-table))))
string<?))
;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
(define (common:get-disks #!key (configf #f))
(hash-table-ref/default
(or configf (read-config "megatest.config" #f #t))
"disks" '("none" "")))
|
| ︙ | ︙ |
Modified configf.scm from [b1cdc5542b] to [39454623be].
| ︙ | ︙ | |||
67 68 69 70 71 72 73 74 75 76 77 78 79 80 |
(define configf:comment-rx (regexp "^\\s*#.*"))
(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))
(define configf:settings (regexp "^\\[configf:settings\\s+(\\S+)\\s+(\\S+)]\\s*$"))
;; read a line and process any #{ ... } constructs
(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get|rget)\\s+([^\\}\\{]*)\\}(.*)"))
(define (configf:process-line l ht allow-system #!key (linenum #f))
(let loop ((res l))
(if (string? res)
(let ((matchdat (string-search configf:var-expand-regex res)))
(if matchdat
(let* ((prestr (list-ref matchdat 1))
(cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
| > | 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 |
(define configf:comment-rx (regexp "^\\s*#.*"))
(define configf:cont-ln-rx (regexp "^(\\s+)(\\S+.*)$"))
(define configf:settings (regexp "^\\[configf:settings\\s+(\\S+)\\s+(\\S+)]\\s*$"))
;; read a line and process any #{ ... } constructs
(define configf:var-expand-regex (regexp "^(.*)#\\{(scheme|system|shell|getenv|get|runconfigs-get|rget)\\s+([^\\}\\{]*)\\}(.*)"))
(define (configf:process-line l ht allow-system #!key (linenum #f))
(let loop ((res l))
(if (string? res)
(let ((matchdat (string-search configf:var-expand-regex res)))
(if matchdat
(let* ((prestr (list-ref matchdat 1))
(cmdtype (list-ref matchdat 2)) ;; eval, system, shell, getenv
|
| ︙ | ︙ | |||
95 96 97 98 99 100 101 | (conc "(lambda (ht)(config-lookup ht \"" sect "\" \"" var "\"))"))) ((runconfigs-get) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) ((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))")) (else "(lambda (ht)(print \"ERROR\") \"ERROR\")")))) ;; (print "fullcmd=" fullcmd) (handle-exceptions exn | > | > | 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 |
(conc "(lambda (ht)(config-lookup ht \"" sect "\" \"" var "\"))")))
((runconfigs-get) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
((rget) (conc "(lambda (ht)(runconfigs-get ht \"" cmd "\"))"))
(else "(lambda (ht)(print \"ERROR\") \"ERROR\")"))))
;; (print "fullcmd=" fullcmd)
(handle-exceptions
exn
(begin
(debug:print 0 "WARNING: failed to process config input \"" l "\"")
(set! result (conc "#{( " cmdtype ") " cmd"}")))
(if (or allow-system
(not (member cmdtype '("system" "shell"))))
(with-input-from-string fullcmd
(lambda ()
(set! result ((eval (read)) ht))))
(set! result (conc "#{(" cmdtype ") " cmd "}"))))
(case cmdsym
|
| ︙ | ︙ |
Modified db.scm from [4086ee6f36] to [b23efd4823].
| ︙ | ︙ | |||
695 696 697 698 699 700 701 |
))
fromdats)
(sqlite3:finalize! stmth)))
(append (list todb) slave-dbs))))
tbls)
(let* ((runtime (- (current-milliseconds) start-time))
(should-print (common:low-noise-print 120 "db sync" (> runtime 500)))) ;; low and high sync times treated as separate.
| | | 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 |
))
fromdats)
(sqlite3:finalize! stmth)))
(append (list todb) slave-dbs))))
tbls)
(let* ((runtime (- (current-milliseconds) start-time))
(should-print (common:low-noise-print 120 "db sync" (> runtime 500)))) ;; low and high sync times treated as separate.
(if should-print (debug:print 2 "INFO: db sync, total run time " runtime " ms"))
(for-each
(lambda (dat)
(let ((tblname (car dat))
(count (cdr dat)))
(set! tot-count (+ tot-count count))
(if (> count 0)
(if should-print (debug:print 0 (format #f " ~10a ~5a" tblname count))))))
|
| ︙ | ︙ |
Modified megatest-version.scm from [c5b3686eee] to [692c2db5a6].
1 2 3 4 5 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00.. (declare (unit megatest-version)) | | | 1 2 3 4 5 6 7 | ;; Always use two or four digit decimal ;; 1.01, 1.02...1.10,1.11,1,1101 ... 1.99,2.00.. (declare (unit megatest-version)) (define megatest-version 1.6027) |