17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
srfi-18 extras format pkts regex
(prefix dbi dbi:)) ;; zmq extras)
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
;; (declare (uses runs))
;; (declare (uses launch))
;; (declare (uses server))
;; (declare (uses client))
;; (declare (uses tests))
;; (declare (uses genexample))
;; (declare (uses daemon))
;; (declare (uses db))
;; ;; (declare (uses dcommon))
;;
;; (declare (uses tdb))
;; (declare (uses mt))
;; (declare (uses api))
;; (declare (uses tasks)) ;; only used for debugging.
;; (declare (uses env))
;; (declare (uses diff-report))
;;
;; (define *db* #f) ;; this is only for the repl, do not use in general!!!!
;; (include "common_records.scm")
;; (include "key_records.scm")
;; (include "db_records.scm")
;; (include "run_records.scm")
import : import pkts
dispatch : dispatch queued run jobs from imported pkts
rungen : look at input sense list in [rungen] and generate run pkts
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>
>
>
>
<
<
<
|
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
srfi-18 extras format pkts regex
(prefix dbi dbi:)) ;; zmq extras)
(declare (uses common))
(declare (uses megatest-version))
(declare (uses margs))
(declare (uses configf))
(include "megatest-fossil-hash.scm")
(let ((debugcontrolf (conc (get-environment-variable "HOME") "/.mtutilrc")))
(if (file-exists? debugcontrolf)
(load debugcontrolf)))
;; Disabled help items
;; -rollup : (currently disabled) fill run (set by :runname) with latest test(s)
;; from prior runs with same keys
;; Contour actions
;; import : import pkts
;; dispatch : dispatch queued run jobs from imported pkts
;; rungen : look at input sense list in [rungen] and generate run pkts
(define help (conc "
mtutil, part of the Megatest tool suite, documentation at http://www.kiatoa.com/fossils/megatest
version " megatest-version "
license GPL, Copyright Matt Welland 2006-2017
Usage: mtutil action [options]
-h : this help
-manual : show the Megatest user manual
-version : print megatest version (currently " megatest-version ")
Actions:
run : initiate runs
remove : remove runs
rerun : register action for processing
set-ss : set state/status
archive : compress and move test data to archive disk
kill : stop tests or entire runs
Contour actions:
process : runs import, rungen and dispatch
Selectors
-immediate : apply this action immediately, default is to queue up actions
-area areapatt1,area2... : apply this action only to the specified areas
-target key1/key2/... : run for key1, key2, etc.
-test-patt p1/p2,p3/... : % is wildcard
|
377
378
379
380
381
382
383
384
385
386
387
388
389
390
|
)
;; look in runstarts for matching runs by target and contour
;; get the timestamp for when that run started and pass it
;; to the rule logic here where "ruletype" will be applied
;; if it comes back "changed" then proceed to register the runs
(case (string->symbol ruletype)
((file file-or) ;; one or more files must be newer than the reference
(let* ((file-globs (cdr valparts))
(youngestdat (common:get-youngest file-globs))
(youngestmod (car youngestdat)))
;; (print "youngestmod: " youngestmod " starttimes: " starttimes)
(if (null? starttimes) ;; this target has never been run
(configf:section-var-set! torun contour runkey `("file:neverrun" ,runname))
|
>
>
>
>
>
>
>
>
>
>
>
>
|
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
|
)
;; look in runstarts for matching runs by target and contour
;; get the timestamp for when that run started and pass it
;; to the rule logic here where "ruletype" will be applied
;; if it comes back "changed" then proceed to register the runs
(case (string->symbol ruletype)
((scheduled)
(if (not (eq? (length valparts) 6))
(print "ERROR: bad sense spec \"" (string-intersperse sense " ") "\"")
(let* ((run-name (car valparts))
(crontab (string-intersperse (cdr valparts)))
(last-run (if (null? starttimes) ;; never run
0
(apply max (map cdr starttimes))))
(need-run (common:cron-event crontab #f last-run)))
(print "last-run: " last-run " need-run: " need-run)
(if need-run
(configf:section-var-set! torun contour runkey `(,(conc ruletype ":" (string-intersperse (cdr valparts) "-")) ,runname))))))
((file file-or) ;; one or more files must be newer than the reference
(let* ((file-globs (cdr valparts))
(youngestdat (common:get-youngest file-globs))
(youngestmod (car youngestdat)))
;; (print "youngestmod: " youngestmod " starttimes: " starttimes)
(if (null? starttimes) ;; this target has never been run
(configf:section-var-set! torun contour runkey `("file:neverrun" ,runname))
|
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
|
;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (dispatch-commands mtconf toppath)
(with-queue-db
mtconf
(lambda (pktsdirs pktsdir pdb)
(let* ((rgconfdat (find-and-read-config (conc toppath "/rungen.config")))
(rgconf (car rgconfdat))
(areas (configf:get-section mtconf "areas"))
(contours (configf:get-section mtconf "contours"))
(pkts (find-pkts pdb '(cmd) '()))
(torun (make-hash-table)) ;; target => ( ... info ... )
(rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering
(for-each
|
|
|
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
|
;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (dispatch-commands mtconf toppath)
(with-queue-db
mtconf
(lambda (pktsdirs pktsdir pdb)
(let* ((rgconfdat (find-and-read-config (conc toppath "/runconfigs.config")))
(rgconf (car rgconfdat))
(areas (configf:get-section mtconf "areas"))
(contours (configf:get-section mtconf "contours"))
(pkts (find-pkts pdb '(cmd) '()))
(torun (make-hash-table)) ;; target => ( ... info ... )
(rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering
(for-each
|