| ︙ | | |
215
216
217
218
219
220
221
222
223
224
225
226
227
228
|
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
|
+
+
|
("-sync-to" . k)
("-new" . l) ;; l (see below) is new-ss
("-run-name" . n)
("-mode-patt" . o)
("-test-patt" . p) ;; idea, enhance margs ("-test-patt" "-testpatt") => yields one value in "-test-patt"
("-status" . s)
("-target" . t)
("-reqtarg" . R)
("-tag-expr" . x)
;; misc
("-debug" . #f) ;; for *verbosity* > 2
("-load" . #f) ;; load and exectute a scheme file
("-log" . #f)
("-override-user" . #f)
("-msg" . M)
|
| ︙ | | |
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
|
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
|
+
+
+
|
("-manual" . #f)
("-version" . #f)
;; misc
("-repl" . #f)
("-immediate" . I)
("-preclean" . r)
("-prepend-contour" . w)
("-force" . F)
("-list-pkt-keys" . #f)
))
;; alist to map actions to old megatest commands
(define *action-keys*
'((run . "-run")
(rerun-clean . "-rerun-clean")
(rerun-all . "-rerun-all")
(kill-run . "-kill-runs")
(kill-rerun . "-kill-rerun")
(lock . "-lock")
(unlock . "-unlock")
(sync . "")
(archive . "-archive")
(set-ss . "-set-state-status")
(remove . "-remove-runs")))
;; manually keep this list updated from the keys to
;; the case *action* near the end of this file.
|
| ︙ | | |
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
|
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
|
+
+
+
+
+
+
+
+
+
+
+
-
+
|
;; the script is called like this: scriptname contour runkey std-runname action extra_param1 extra_param2 ...
(for-each
(lambda (cmd)
;;(print "cmd: " cmd)
;;(print "Areas: " all-areas)
(for-each
(lambda (area)
;;(print "Area: " area)
;;(print "Target: " runkey)
;;(print "OR: " (or (string->number (if (configf:lookup mtconf "setup" "max_packets_per_run") (configf:lookup mtconf "setup" "max_packets_per_run") "10000" ))))
;;(print "Packets generated: " packets-generated)
;;(print "Comparison: " (< packets-generated 4))
;;(print "Full Comparison: "
;; (and (< packets-generated (or (string->number (if (configf:lookup mtconf "setup" "max_packets_per_run") (configf:lookup mtconf "setup" "max_packets_per_run") "10000" )) 10000))
;; (if (args:get-arg "-target")
;; (if (string= (args:get-arg "-target") runkey) (area-allowed? area "area-needs-to-be-run" runkey contour #f) #f)
;; (area-allowed? area "area-needs-to-be-run" runkey contour #f))))
;;(print "Area Allowed: " (area-allowed? area "area-needs-to-be-run" runkey contour #f))
;Add code to check whether area is valid
(if
;; This code checks whether the target has been passed in via argument, and only runs the specified target
(and (< packets-generated 4) (if (args:get-arg "-target")
(and (< packets-generated (or (string->number (if (configf:lookup mtconf "setup" "max_packets_per_run") (configf:lookup mtconf "setup" "max_packets_per_run") "10000" )) 10000)) (if (args:get-arg "-target")
(if (string= (args:get-arg "-target") runkey) (area-allowed? area "area-needs-to-be-run" runkey contour #f) #f)
(area-allowed? area "area-needs-to-be-run" runkey contour #f)))
(let* ((script (car cmd))
(params (cdr cmd))
(cmd (conc script " " contour " " area " " runkey " " std-runname " " action " " params))
(res (handle-exceptions
|
| ︙ | | |
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
|
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
|
-
+
|
;; runtrans)
(print "key-msg: " key-msg)
;;(push-run-spec torun contour
;; (if optional ;; we need to be able to differentiate same contour, different behavior.
;; (conc runkey ":" optional) ;; NOTE: NOT COMPLETELY IMPLEMENTED. DO NOT USE
;; runkey)
;; key-msg)
))))))) (filter (lambda (x) (if (not (args:get-arg "-area")) #t (if (string= x (args:get-arg "-area")) #t #f))) all-areas))
))))) (print "Skipping area: " area " and target: " runkey " due to packets-generated: " packets-generated " higher than " (configf:lookup mtconf "setup" "max_packets_per_run") ) ) ) (filter (lambda (x) (if (not (args:get-arg "-area")) #t (if (string= x (args:get-arg "-area")) #t #f))) all-areas))
) val-alist)) ;; iterate over the param split by ;\s*
;; fossil scm based triggers
;;
((fossil)
(for-each
(lambda (fspec)
|
| ︙ | | |
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
|
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
|
-
+
+
|
; (hash-table-set! args:arg-hash "-log" logf)) ;; fake out future queries of -log
(print *default-log-port* "Sending log output to " logf)
(set! *default-log-port* oup)
)))
(if *action*
(case (string->symbol *action*)
((run remove rerun rerun-clean rerun-all set-ss archive kill list kill-run kill-rerun)
((run remove rerun rerun-clean rerun-all set-ss archive kill list kill-run kill-rerun lock unlock)
(let* ((mtconfdat (simple-setup (args:get-arg "-start-dir")))
(mtconf (car mtconfdat))
(area (args:get-arg "-area")) ;; look up the area to dispatch to from [areas] section
(areasec (if area (configf:lookup mtconf "areas" area) #f))
(areadat (if areasec (common:val->alist areasec) #f))
(area-path (if areadat (alist-ref 'path areadat) #f))
(pktsdirs (configf:lookup mtconf "setup" "pktsdirs"))
|
| ︙ | | |