Megatest

Diff
Login

Differences From Artifact [cbfcb5b3d1]:

To Artifact [df18d8fd34]:


17
18
19
20
21
22
23



24
25
26
27
28
29
30
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33







+
+
+







;;     along with Megatest.  If not, see <http://www.gnu.org/licenses/>.

;;======================================================================

(declare (unit mtmod))
;; (declare (uses mtargs))
(declare (uses debugprint))
(declare (uses commonmod))
(declare (uses dbmod))
;; (declare (uses rmtmod))

(module mtmod
	*
	
(import scheme

	chicken.base
39
40
41
42
43
44
45



46
47
48
49
50
51
52
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58







+
+
+







	chicken.sort
	chicken.string
	chicken.time

	debugprint
	;; mtargs
	;; pkts
	commonmod
	dbmod
	;; rmtmod
	
	(prefix base64 base64:)
	(prefix dbi dbi:)
	(prefix sqlite3 sqlite3:)
	(srfi 18)
	directory-utils
	format
61
62
63
64
65
66
67
68
69






















































67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128








-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
	srfi-69
	stack
	typed-records
	z3
	
	)


)

;; (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking (srfi 18) posix-extras directory-utils call-with-environment-variables)
;; (import (prefix sqlite3 sqlite3:))
;; 
;; (declare (unit mt))
;; (declare (uses db))
;; (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")

;; This is the Megatest API. All generally "useful" routines will be wrapped or extended
;; here.


(define (mt:get-run-stats dbstruct run-id)
;;  Get run stats from local access, move this ... but where?
  (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 *default-log-port* "Discarding tests from " tests " that are waiting on " failed-test)
	(let loop ((testn (car tests))
		   (remt  (cdr tests))
		   (res   '()))
	  (let* ((test-dat (hash-table-ref/default test-records testn (vector #f #f '())))
		 (waitons  (vector-ref test-dat 2)))
	    ;; (print "mt:discard-blocked-tests run-id: " run-id " failed-test: " failed-test " testn: " testn " with waitons: " waitons)
	    (if (null? remt)
		(let ((new-res (reverse res)))
		  ;; (print "       new-res: " new-res)
		  new-res)
		(loop (car remt)
		      (cdr remt)
		      (if (member failed-test waitons)
			  (begin
			    (debug:print 0 *default-log-port* "Discarding test " testn "(" test-dat ") due to " failed-test)
			    res)
			  (cons testn res)))))))))


)