Overview
| Comment: | Adapt to refactored pkts egg. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.64-new-pkts |
| Files: | files | file ages | folders |
| SHA1: |
8a6b4757c852efbe417bae44c38a1636 |
| User & Date: | matt on 2017-03-16 18:05:05 |
| Other Links: | branch diff | manifest | tags |
Context
|
2017-03-16
| ||
| 20:57 | Make linktree default to MT_RUN_AREA_HOME/lt and a linktree setting is no longer needed in megatest.config. check-in: a0adf06969 user: matt tags: v1.64-new-pkts | |
| 18:05 | Adapt to refactored pkts egg. check-in: 8a6b4757c8 user: matt tags: v1.64-new-pkts | |
|
2017-03-15
| ||
| 23:44 | Cleaned up after bug squishing. Several minor bugs found. Added all-rmt unit test and made it the default sole unit flow to run Closed-Leaf check-in: 77f7d5ef17 user: matt tags: v1.64-bug-sqlish | |
Changes
Modified mtut.scm from [fdb1ede093] to [9e88c442a2].
| ︙ | ︙ | |||
10 11 12 13 14 15 16 | ;; (include "common.scm") ;; (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) | | | 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 |
;; (include "common.scm")
;; (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 pkts regex regex-case
(prefix dbi dbi:)) ;; zmq extras)
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses rmt))
|
| ︙ | ︙ | |||
341 342 343 344 345 346 347 | (lambda (pkt) (let* ((uuid (cadr (string-match ".*/([0-9a-f]+).pkt" pkt))) (exists (lookup-by-uuid pdb uuid #f))) (if (not exists) (let* ((pktdat (string-intersperse (with-input-from-file pkt read-lines) "\n")) | | | | 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 |
(lambda (pkt)
(let* ((uuid (cadr (string-match ".*/([0-9a-f]+).pkt" pkt)))
(exists (lookup-by-uuid pdb uuid #f)))
(if (not exists)
(let* ((pktdat (string-intersperse
(with-input-from-file pkt read-lines)
"\n"))
(apkt (pkt->alist pktdat))
(ptype (alist-ref 'T apkt)))
(add-to-queue pdb pktdat uuid (or ptype 'cmd) #f 0)
(debug:print 4 *default-log-port* "Added " uuid " of type " ptype " to queue"))
(debug:print 4 *default-log-port* "pkt: " uuid " exists, skipping...")
)))
pkts))))
(string-split pktsdirs)))))
(define (get-pkt-alists pkts)
(map (lambda (x)
(alist-ref 'apkt x)) ;; 'pkta pulls out the alist from the read pkt
pkts))
;; given list of pkts (alist mode) return list of D cards as Unix epoch, sorted descending
;; also delete duplicates by target i.e. (car pkt)
(define (get-pkt-times pkts)
(delete-duplicates
(sort
|
| ︙ | ︙ | |||
760 761 762 763 764 765 766 |
(fold (lambda (a res)
(let* ((key (car a)) ;; get the key name
(val (cdr a))
(par (lookup-param-by-key key)))
;; (print "key: " key " val: " val " par: " par)
(if par
(conc res " " (param-translate par) " " val)
| | | 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 |
(fold (lambda (a res)
(let* ((key (car a)) ;; get the key name
(val (cdr a))
(par (lookup-param-by-key key)))
;; (print "key: " key " val: " val " par: " par)
(if par
(conc res " " (param-translate par) " " val)
(if (member key '(a Z U D T)) ;; a is the action
res
(begin
(print "ERROR: Unknown key in packet \"" key "\" with value \"" val "\"")
res)))))
(conc "megatest " (if (not (member action '("sync")))
(conc action " ")
""))
|
| ︙ | ︙ | |||
806 807 808 809 810 811 812 | (areas (configf:get-section mtconf "areas")) (contours (configf:get-section mtconf "contours")) (pkts (find-pkts pdb '(cmd) '())) (torun (make-hash-table)) ;; target => ( ... info ... ) (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering (for-each (lambda (pktdat) | | | 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 | (areas (configf:get-section mtconf "areas")) (contours (configf:get-section mtconf "contours")) (pkts (find-pkts pdb '(cmd) '())) (torun (make-hash-table)) ;; target => ( ... info ... ) (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering (for-each (lambda (pktdat) (let* ((pkta (alist-ref 'apkt pktdat)) (action (alist-ref 'a pkta)) (cmdline (pkt->cmdline pkta)) (uuid (alist-ref 'Z pkta)) (logf (conc logdir "/" uuid "-run.log")) (fullcmd (conc "NBFAKE_LOG=" logf " nbfake " cmdline))) (print "RUNNING: " fullcmd) (system fullcmd) |
| ︙ | ︙ |