Megatest

Diff
Login

Differences From Artifact [b59cdde8b5]:

To Artifact [f56eafe3d7]:


16
17
18
19
20
21
22

23
24
25
26
27
28
29
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30







+







(declare (uses common))
(declare (uses items))
(declare (uses runconfig))
(declare (uses tests))
(declare (uses server))
(declare (uses runs))
(declare (uses rmt))
(declare (uses filedb))

(include "common_records.scm")
(include "key_records.scm")
(include "db_records.scm")
(include "run_records.scm")
(include "test_records.scm")

94
95
96
97
98
99
100

101
102
103

104
105
106
107
108
109
110
95
96
97
98
99
100
101
102
103


104
105
106
107
108
109
110
111







+

-
-
+







	(let ((result (vector-ref res 1)))
	  (debug:print 4 "Using lazy value res: " result)
	  result)
	(let ((newres (rmt:get-prereqs-not-met run-id waitons ref-item-path mode: mode)))
	  (hash-table-set! *pre-reqs-met-cache* key (vector (current-seconds) newres))
	  newres))))

(define (mt:get-run-stats dbstruct run-id)
;;  Get run stats from local access, move this ... but where?
(define (mt:get-run-stats)
  (db:get-run-stats #f))
  (db:get-run-stats dbstruct run-id))

(define (mt:discard-blocked-tests run-id failed-test tests test-records)
  (if (null? tests)
      tests
      (begin
	(debug:print-info 1 "Discarding tests from " tests " that are waiting on " failed-test)
	(let loop ((testn (car tests))
124
125
126
127
128
129
130
131

132
133
134
135
136
137
138
125
126
127
128
129
130
131

132
133
134
135
136
137
138
139







-
+








;;======================================================================
;;  T R I G G E R S
;;======================================================================

(define (mt:process-triggers test-id newstate newstatus)
  (let* ((test-dat      (rmt:get-test-info-by-id test-id))
	 (test-rundir   (db:test-get-rundir test-dat))
	 (test-rundir   (filedb:get-path *fdb* (db:test-get-rundir test-dat)))
	 (test-name     (db:test-get-testname test-dat))
	 (tconfig       #f)
	 (state         (if newstate  newstate  (db:test-get-state  test-dat)))
	 (status        (if newstatus newstatus (db:test-get-status test-dat))))
    (if (and (file-exists? test-rundir)
	     (directory? test-rundir))
	(begin