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
|
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))
;; (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
|
377
378
379
380
381
382
383
384
385
386
387
388
389
390
|
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
|
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 "/rungen.config")))
(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
|