251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
|
;;======================================================================
;; U T I L S
;;======================================================================
;; given a mtutil param, return the old megatest equivalent
;;
(define (param-translate param)
(or (alist-ref (string->symbol param)
'((-tag-expr . "-tagexpr")
(-mode-patt . "-modepatt")
(-run-name . "-runname")
(-test-patt . "-testpatt")
(-msg . "-m")
(-new . "-set-state-status")))
param))
(define (val->alist val)
(let ((val-list (string-split-fields ";\\s*" val #:infix)))
(if val-list
(map (lambda (x)
(let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
(case (length f)
|
|
>
|
<
<
<
<
<
<
|
|
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
|
;;======================================================================
;; U T I L S
;;======================================================================
;; given a mtutil param, return the old megatest equivalent
;;
(define (megatest-param->mtutil-param param)
(let* ((mapping-alist (common:get-param-mapping flavor: 'switch-symbol)))
(alist-ref (string->symbol param) mapping-alist eq? param)
param))
(define (val->alist val)
(let ((val-list (string-split-fields ";\\s*" val #:infix)))
(if val-list
(map (lambda (x)
(let ((f (string-split-fields "\\s*=\\s*" x #:infix)))
(case (length f)
|
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
|
runkeydats)))
(let ((res (configf:get-section torun contour))) ;; each contour / target
;; (print "res=" res)
res))))
(hash-table-keys torun)))))))
(define (pkt->cmdline pkta)
(let* ((action (or (lookup-action-by-key (alist-ref 'A pkta)) "noaction"))
(action-param (case (string->symbol action)
((-set-state-status) (conc (alist-ref 'l pkta) " "))
(else ""))))
(fold (lambda (a res)
(let* ((key (car a)) ;; get the key name
(val (cdr a))
(par (or (lookup-param-by-key key) ;; need to check also if it is a switch
(lookup-param-by-key key inlst: *switch-keys*))))
;; (print "key: " key " val: " val " par: " par)
(if par
(conc res " " (param-translate par) " " val)
(if (alist-ref key *additional-cards*) ;; these cards do not translate to parameters or switches
res
(begin
(print "ERROR: Unknown key in packet \"" key "\" with value \"" val "\"")
res)))))
(conc "megatest " (if (not (member action '("sync")))
(conc action " " action-param)
|
>
|
|
|
|
|
|
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
|
runkeydats)))
(let ((res (configf:get-section torun contour))) ;; each contour / target
;; (print "res=" res)
res))))
(hash-table-keys torun)))))))
(define (pkt->cmdline pkta)
(let* ((param-mapping-alist (common:get-param-mapping flavor: 'switch-symbol))
(action (or (lookup-action-by-key (alist-ref 'A pkta)) "noaction"))
(action-param (case (string->symbol action)
((-set-state-status) (conc (alist-ref 'l pkta) " "))
(else ""))))
(fold (lambda (a res)
(let* ((key (car a)) ;; get the key name
(val (cdr a))
(par (or (lookup-param-by-key key) ;; need to check also if it is a switch
(lookup-param-by-key key inlst: *switch-keys*))))
;; (print "key: " key " val: " val " par: " par)
(if par
(conc res " " (alist-ref (string->symbol par) param-mapping-alist eq? par) " " val)
(if (alist-ref key *additional-cards*) ;; these cards do not translate to parameters or switches
res
(begin
(print "ERROR: Unknown key in packet \"" key "\" with value \"" val "\"")
res)))))
(conc "megatest " (if (not (member action '("sync")))
(conc action " " action-param)
|
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
|
(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")
(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")))))))
)) ;; the end
|
>
>
>
|
|
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
|
(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")))))))
)) ;; the end
|