11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
|
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
srfi-18 extras format pkts regex regex-case
(prefix dbi dbi:)
(prefix nanomsg nmsg:))
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
|
|
|
|
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
|
;; (include "megatest-version.scm")
;; fake out readline usage of toplevel-command
(define (toplevel-command . a) #f)
(use srfi-1 posix srfi-69 readline ;; regex regex-case srfi-69 apropos json http-client directory-utils rpc typed-records;; (srfi 18) extras)
srfi-18 extras format pkts regex regex-case
(prefix dbi dbi:))
;;(prefix nanomsg nmsg:))
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
|
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
|
(string-split (or areas-string "") ","))))
;; area - the current area under consideration
;; areas - the list of allowed areas from the contour spec -OR-
;; if it is a string then it is the function to use to
;; lookup in *area-checkers*
;;
(define (area-allowed? area areas runkey contour)
(cond
((not areas) #t) ;; no spec
((string? areas) ;;
(let ((check-fn (hash-table-ref/default *area-checkers* areas #f)))
(if check-fn
(check-fn area runkey contour)
#f)))
((list? areas)(member area areas))
(else #f))) ;; shouldn't get here
;; (use trace)(trace create-run-pkt)
;; collect all needed data and create run pkts for contours with changed inputs
|
|
|
|
|
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
|
(string-split (or areas-string "") ","))))
;; area - the current area under consideration
;; areas - the list of allowed areas from the contour spec -OR-
;; if it is a string then it is the function to use to
;; lookup in *area-checkers*
;;
(define (area-allowed? area areas runkey contour mode-patt)
(cond
((not areas) #t) ;; no spec
((string? areas) ;;
(let ((check-fn (hash-table-ref/default *area-checkers* (string->symbol areas) #f)))
(if check-fn
(check-fn area runkey contour mode-patt)
#f)))
((list? areas)(member area areas))
(else #f))) ;; shouldn't get here
;; (use trace)(trace create-run-pkt)
;; collect all needed data and create run pkts for contours with changed inputs
|
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
|
;; (print "runkeydatset: ")(pp runkeydatset)
(let ((runkey (car runkeydatset))
(runkeydats (cadr runkeydatset)))
(for-each
(lambda (runkeydat)
(for-each
(lambda (area)
(if (area-allowed? area areas runkey contour) ;; is this area to be handled (from areas=a,b,c OR using areafn=abcfn and *area-checks* ...)
(let* ((aval (or (configf:lookup mtconf "areas" area) ""))
(aval-alist (val->alist aval))
(runname (alist-ref 'runname runkeydat))
(runtrans (alist-ref 'runtrans runkeydat))
(reason (alist-ref 'message runkeydat))
(sched (alist-ref 'sched runkeydat))
|
|
|
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
|
;; (print "runkeydatset: ")(pp runkeydatset)
(let ((runkey (car runkeydatset))
(runkeydats (cadr runkeydatset)))
(for-each
(lambda (runkeydat)
(for-each
(lambda (area)
(if (area-allowed? area areas runkey contour mode-patt) ;; is this area to be handled (from areas=a,b,c OR using areafn=abcfn and *area-checks* ...)
(let* ((aval (or (configf:lookup mtconf "areas" area) ""))
(aval-alist (val->alist aval))
(runname (alist-ref 'runname runkeydat))
(runtrans (alist-ref 'runtrans runkeydat))
(reason (alist-ref 'message runkeydat))
(sched (alist-ref 'sched runkeydat))
|