︙ | | | ︙ | |
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
-repl : start a repl (useful for extending megatest)
-load file.scm : load and run file.scm
-debug N|N,M,O... : enable debug messages 0-N or N and M and O ...
-list-pkt-keys : list all pkt keys
Utility
db pgschema : emit postgresql schema; do \"mtutil db pgschema | psql -d mydb\"
Examples:
# Start a megatest run in the area \"mytests\"
mtutil run -area mytests -target v1.63/aa3e -mode-patt MYPATT -tag-expr quick
# Start a contour
|
>
>
>
|
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
-repl : start a repl (useful for extending megatest)
-load file.scm : load and run file.scm
-debug N|N,M,O... : enable debug messages 0-N or N and M and O ...
-list-pkt-keys : list all pkt keys
Utility
db pgschema : emit postgresql schema; do \"mtutil db pgschema | psql -d mydb\"
gatherdb [propagate] : gather dbs from all areas into /tmp/$USER_megatest/alldbs,
optionally propagate the data to megatest2.0 format
Examples:
# Start a megatest run in the area \"mytests\"
mtutil run -area mytests -target v1.63/aa3e -mode-patt MYPATT -tag-expr quick
# Start a contour
|
︙ | | | ︙ | |
610
611
612
613
614
615
616
617
618
619
620
621
622
623
|
;; we set some dynamic data in a section called "scratchdata"
(if mtconf
(begin
(configf:section-var-set! mtconf "scratchdat" "toppath" start-dir)))
;; (print "TOPPATH: " (configf:lookup mtconf "scratchdat" "toppath"))
mtconfdat))
;; NEED TIMESTAMP ON PKTS for efficient loading of packets into db.
;; make a run request pkt from basic data, this seriously needs to be refactored
;; i. Take the code that builds the info to submit to create-run-pkt and have it
;; generate the pkt keys directly.
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
|
;; we set some dynamic data in a section called "scratchdata"
(if mtconf
(begin
(configf:section-var-set! mtconf "scratchdat" "toppath" start-dir)))
;; (print "TOPPATH: " (configf:lookup mtconf "scratchdat" "toppath"))
mtconfdat))
;;======================================================================
;; Areas
;;======================================================================
;; look for areas=a1,a2,a3 OR areafn=somefuncname
;;
(define (val-alist->areas val-alist)
(let ((areas-string (alist-ref 'areas val-alist))
(areas-procname (alist-ref 'areafn val-alist)))
(if areas-procname ;; areas-procname take precedence
areas-procname
(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
(define (get-area-names mtconf)
(map car (configf:get-section mtconf "areas")))
;;======================================================================
;; Pkts for remote control
;;======================================================================
;; NEED TIMESTAMP ON PKTS for efficient loading of packets into db.
;; make a run request pkt from basic data, this seriously needs to be refactored
;; i. Take the code that builds the info to submit to create-run-pkt and have it
;; generate the pkt keys directly.
|
︙ | | | ︙ | |
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
|
extra-dat: `(a ,runkey) ;; we need the run key for marking the run as launched
)))
(with-output-to-file
(conc pktsdir "/" uuid ".pkt")
(lambda ()
(print pkt))))))
;; look for areas=a1,a2,a3 OR areafn=somefuncname
;;
(define (val-alist->areas val-alist)
(let ((areas-string (alist-ref 'areas val-alist))
(areas-procname (alist-ref 'areafn val-alist)))
(if areas-procname ;; areas-procname take precedence
areas-procname
(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
;;
(define (generate-run-pkts mtconf toppath)
(let ((std-runname (conc "sched" (time->string (seconds->local-time (current-seconds)) "%M%H%d"))))
(common:with-queue-db
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
731
732
733
734
735
736
737
738
739
740
741
742
743
744
|
extra-dat: `(a ,runkey) ;; we need the run key for marking the run as launched
)))
(with-output-to-file
(conc pktsdir "/" uuid ".pkt")
(lambda ()
(print pkt))))))
;; (use trace)(trace create-run-pkt)
;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (generate-run-pkts mtconf toppath)
(let ((std-runname (conc "sched" (time->string (seconds->local-time (current-seconds)) "%M%H%d"))))
(common:with-queue-db
|
︙ | | | ︙ | |
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
|
(let ((portnum (string->number (car remargs))))
(if (not portnum)
(print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs))
(begin
(if (not (is-port-in-use portnum))
(let* ((rep (start-nn-server portnum))
(mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(script (configf:lookup mtconf "listener" "script")))
(print "Listening on port " portnum " for messages")
(set-signal-handler! signal/int special-signal-handler)
(set-signal-handler! signal/term special-signal-handler)
(let loop ((instr (nn-recv rep)))
(print "received " instr ", running \"" script " " instr "\"")
(system (conc script " '" instr "'"))
(nn-send rep "ok")
(loop (nn-recv rep))))
(print "ERROR: Port " portnum " already in use. Try another port")))))))
(else
(let ((all-actions (sort (map conc (delete-duplicates (append *other-actions* (map car *action-keys*)))) string<=?)))
(print "unrecognised action: \"" *action* "\", try one of; \"" (string-intersperse all-actions "\", \"") "\"")))
)) ;; the end
|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
|
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
|
(let ((portnum (string->number (car remargs))))
(if (not portnum)
(print "ERROR: the portnumber parameter must be a number, you gave: " (car remargs))
(begin
(if (not (is-port-in-use portnum))
(let* ((rep (start-nn-server portnum))
(mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(script (configf:lookup mtconf "listener" "script")))
(print "Listening on port " portnum " for messages")
(set-signal-handler! signal/int special-signal-handler)
(set-signal-handler! signal/term special-signal-handler)
(let loop ((instr (nn-recv rep)))
(print "received " instr ", running \"" script " " instr "\"")
(system (conc script " '" instr "'"))
(nn-send rep "ok")
(loop (nn-recv rep))))
(print "ERROR: Port " portnum " already in use. Try another port")))))))
((gather) ;; gather all area db's into /tmp/$USER_megatest/alldbs
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(areas (get-area-names mtconf)))
(print "areas: " areas)))
(else
(let ((all-actions (sort (map conc (delete-duplicates (append *other-actions* (map car *action-keys*)))) string<=?)))
(print "unrecognised action: \"" *action* "\", try one of; \"" (string-intersperse all-actions "\", \"") "\"")))
)) ;; the end
|
︙ | | | ︙ | |