Megatest

Diff
Login

Differences From Artifact [e088c8d9d0]:

To Artifact [2875b68fc1]:


109
110
111
112
113
114
115
116
117

118
119
120
121
122
123
124
109
110
111
112
113
114
115


116
117
118
119
120
121
122
123







-
-
+








Called as " (string-intersperse (argv) " ") "
Version " megatest-version ", built from " megatest-fossil-hash ))

;; args and pkt key specs
;;
(define *arg-keys*
  '(("-run"        . r)
    ("-area"       . G) ;; maps to group
  '(("-area"       . G) ;; maps to group
    ("-target"     . t)
    ("-run-name"   . n)
    ("-state"      . e)
    ("-status"     . s)
    ("-contour"    . c)
    ("-test-patt"  . p)  ;; idea, enhance margs ("-test-patt" "-testpatt") => yields one value in "-test-patt"
    ("-mode-patt"  . o)
196
197
198
199
200
201
202






203
204
205
206
207
208
209
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214







+
+
+
+
+
+







(if (and (not (null? remargs))
	 (not (or
	       (args:get-arg "-runstep")
	       (args:get-arg "-envcap")
	       (args:get-arg "-envdelta")
	       )))
    (debug:print-error 0 *default-log-port* "Unrecognised arguments: " (string-intersperse (if (list? remargs) remargs (argv))  " ")))

(if (or (args:any? "-h" "help" "-help" "--help")
	(member *action* '("-h" "-help" "--help" "help")))
    (begin
      (print help)
      (exit 1)))

;;======================================================================
;; pkts
;;======================================================================

(define (with-queue-db mtconf proc)
  (let* ((pktsdirs (configf:lookup mtconf "setup"  "pktsdirs"))
293
294
295
296
297
298
299




300
301
302
303
304
305
306
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315







+
+
+
+







	 (mtconf    (if mtconfdat (car mtconfdat) #f)))
    ;; we set some dynamic data in a section called "dyndata"
    (if mtconf
	(begin
	  (configf:section-var-set! mtconf "dyndat" "toppath" start-dir)))
    (print "TOPPATH: " (configf:lookup mtconf "dyndat" "toppath"))
    mtconfdat))


;; NEED TIMESTAMP ON PKTS for efficient loading of packets into db.


;; make a run request pkt from basic data
;;
(define (create-run-pkt mtconf area runkey runname mode-patt tag-expr pktsdir reason)
  (let ((area-path (configf:lookup mtconf "areas" area)))
    (let-values (((uuid pkt)
		  (command-line->pkt