Megatest

ext-tests path=ext-tests; targtrans=prefix-contour 

[contours]
#     mode-patt/tag-expr
quick selector=quick/QUICKPATT
full  areas=fullrun,ext-tests; selector=all/MAXPATT
all   areas=fullrun,ext-tests
snazy areas=%; selector=/QUICKPATT

;;      generate the pkt keys directly.
;;  ii. Pass the pkt keys and values to this proc and go from there.
;; iii. Maybe have an abstraction alist with meaningful names for the pkt keys
;;
;; Override the run start time record with sched. Usually #f is fine.
;;
(define (create-run-pkt mtconf action area runkey runname mode-patt tag-expr pktsdir reason contour sched dbdest append-conf)
  (let* ((good-val   (lambda (inval)(and inval (string? inval)(not (string-null? inval)))))
  (let* ((area-dat   (val->alist (or (configf:lookup mtconf "areas" area) "")))
	 (area-dat   (val->alist (or (configf:lookup mtconf "areas" area) "")))
	 (area-path  (alist-ref 'path      area-dat))
	 (area-xlatr (alist-ref 'targtrans area-dat))
	 (new-target (if area-xlatr
			 (let ((xlatr-key (string->symbol area-xlatr)))
			   (if (alist-ref xlatr-key *target-mappers*)
			       (begin
				 (print "Using target mapper: " area-xlatr)

    (let-values (((uuid pkt)
		  (command-line->pkt
		   (if action action "run")
		   (append 
		    `(("-start-dir"  . ,area-path)
		      ("-msg"        . ,reason)
		      ("-contour"    . ,contour))
		    (if runname     `(("-run-name"   . ,runname))      '())
		    (if new-target  `(("-target"     . ,new-target))   '())
		    (if mode-patt   `(("-mode-patt"  . ,mode-patt))    '())
		    (if tag-expr    `(("-tag-expr"   . ,tag-expr))     '())
		    (if dbdest	    `(("-sync-to"    . ,dbdest))       '())
		    (if append-conf `(("-append-config" . ,append-conf)) '())
		    (if (good-val runname)     `(("-run-name"   . ,runname))      '())
		    (if (good-val new-target)  `(("-target"     . ,new-target))   '())
		    (if (good-val mode-patt)   `(("-mode-patt"  . ,mode-patt))    '())
		    (if (good-val tag-expr)    `(("-tag-expr"   . ,tag-expr))     '())
		    (if (good-val dbdest)      `(("-sync-to"    . ,dbdest))       '())
		    (if (good-val append-conf) `(("-append-config" . ,append-conf)) '())
		    (if (not (or mode-patt tag-expr))
			`(("-testpatt"  . "%"))
			'())
		    )
		   sched)))
      (with-output-to-file
	  (conc pktsdir "/" uuid ".pkt")

	 (for-each
	  (lambda (contour)
	    (print "contour: " contour)
	    (let* ((val       (or (configf:lookup mtconf "contours" contour) ""))
		   (val-alist (val->alist val))
		   (areas     (string-split (or (alist-ref 'areas val-alist) "") ","))
		   (selector  (alist-ref 'selector val-alist))
		   (mode-tag  (and selector (string-split selector "/")))
		   (mode-tag  (and selector (string-split-fields "/" selector #:infix)))
		   (mode-patt (and mode-tag (if (eq? (length mode-tag) 2)(cadr mode-tag) #f)))
		   (tag-expr  (and mode-tag (if (null? mode-tag) #f (car mode-tag)))))
	      (for-each
	       (lambda (runkeydatset)
		 ;; (print "runkeydatset: ")(pp runkeydatset)
		 (let ((runkey     (car runkeydatset))
		       (runkeydats (cadr runkeydatset)))