Megatest

Check-in [1c292f6f90]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Nada
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1c292f6f90a1acb917c8980593b4b3a8f15b3fcc
User & Date: mrwellan on 2011-10-27 20:31:17
Other Links: manifest | tags
Context
2011-10-29
21:51
Fixed test of eztest with logpro check-in: bc64078220 user: matt tags: trunk
2011-10-27
20:31
Nada check-in: 1c292f6f90 user: mrwellan tags: trunk
2011-10-26
14:03
Merged guitweaks (includes stuff from private branches check-in: bb8b14dea5 user: mrwellan tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified dashboard.scm from [f724b05dae] to [31da9fd56a].

︙
280
281
282
283
284
285
286
287

288
289
290
291
292
293
294

280
281
282
283
284
285
286

287
288
289
290
291
292
293
294








-
+








	 ;; sort by second field
	 (vlst-s1 (sort vlst (lambda (a b)
			       (let ((astr (vector-ref a 1))
				     (bstr (vector-ref b 1)))
				 (if (string=? astr "") #f #t)))))
			;; (>= (string-length (vector-ref a 1))(string-length (vector-ref b 1))))))
	 (vlst-s2 (sort vlst-s1 (lambda (a b)
				  (string>= (vector-ref a 0)(vector-ref b 0))))))
			   	  (string>= (vector-ref a 0)(vector-ref b 0))))))
    (map (lambda (x)
	   (if (equal? (vector-ref x 1) "")
	       (vector-ref x 0)
	       (conc (vector-ref x 0) "(" (vector-ref x 1) ")")))
	 vlst-s2)))
    
    ;; (sort newlst (lambda (a b)
︙

Modified task_records.scm from [44007a614c] to [634fd98234]. 

1
2
3
4
5
6
7
8
9
10
11
12
13


14
15
16
17
18
19
20
21

22
23


24
25
26
27
28
29
30

1
2
3
4
5
6
7
8
9
10
11


12
13
14
15
16
17
18
19
20
21
22


23
24
25
26
27
28
29
30
31












-
-
+
+








+
-
-
+
+








;;======================================================================
;; Copyright 2006-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.
;;======================================================================

;; make-vector-record tasks task id action owner state target name test item creation_time execution_time 
(define (make-tasks:task)(make-vector 10))
;; make-vector-record tasks task id action owner state target name test item params creation_time execution_time 
(define (make-tasks:task)(make-vector 11))
(define-inline (tasks:task-get-id               vec)    (vector-ref  vec 0))
(define-inline (tasks:task-get-action           vec)    (vector-ref  vec 1))
(define-inline (tasks:task-get-owner            vec)    (vector-ref  vec 2))
(define-inline (tasks:task-get-state            vec)    (vector-ref  vec 3))
(define-inline (tasks:task-get-target           vec)    (vector-ref  vec 4))
(define-inline (tasks:task-get-name             vec)    (vector-ref  vec 5))
(define-inline (tasks:task-get-test             vec)    (vector-ref  vec 6))
(define-inline (tasks:task-get-item             vec)    (vector-ref  vec 7))
(define-inline (tasks:task-get-params           vec)    (vector-ref  vec 8))
(define-inline (tasks:task-get-creation_time    vec)    (vector-ref  vec 8))
(define-inline (tasks:task-get-execution_time   vec)    (vector-ref  vec 9))
(define-inline (tasks:task-get-creation_time    vec)    (vector-ref  vec 9))
(define-inline (tasks:task-get-execution_time   vec)    (vector-ref  vec 10))

(define-inline (tasks:task-set-state!  vec val)(vector-set! vec 3 val))


;; make-vector-record tasks monitor id pid start_time last_update hostname username
(define (make-tasks:monitor)(make-vector 5))
(define-inline (tasks:monitor-get-id            vec)    (vector-ref  vec 0))
︙

Modified tasks.scm from [0bafc39e74] to [e24a437d48].

︙
35
36
37
38
39
40
41

42
43
44
45
46
47
48

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49








+








                                owner TEXT,
                                state TEXT DEFAULT 'new',
                                target TEXT DEFAULT '',
                                name TEXT DEFAULT '',
                                test TEXT DEFAULT '',
                                item TEXT DEFAULT '',
                                keylock TEXT,
                                params TEXT,
                                creation_time TIMESTAMP,
                                execution_time TIMESTAMP);")
	  (sqlite3:execute tdb "CREATE TABLE IF NOT EXISTS monitors (id INTEGER PRIMARY KEY,
                                pid INTEGER,
                                start_time TIMESTAMP,
                                last_update TIMESTAMP,
                                hostname TEXT,
︙
82
83
84
85
86
87
88
89
90


91
92
93
94
95
96
97


98
99
100
101
102
103
104

83
84
85
86
87
88
89


90
91
92
93
94
95
96
97

98
99
100
101
102
103
104
105
106








-
-
+
+






-
+
+








       (set! res count))
     tdb
     "SELECT count(id) FROM monitors WHERE last_update < (strftime('%s','now') - 300) AND username=?;"
     (car (user-information (current-user-id))))
    res))

;; register a task
(define (tasks:add tdb action owner target runname test item)
  (sqlite3:execute tdb "INSERT INTO tasks_queue (action,owner,state,target,name,test,item,creation_time,execution_time)
(define (tasks:add tdb action owner target runname test item params)
  (sqlite3:execute tdb "INSERT INTO tasks_queue (action,owner,state,target,name,test,item,params,creation_time,execution_time)
                       VALUES (?,?,'new',?,?,?,?,strftime('%s','now'),0);" 
		   action
		   owner
		   target
		   runname
		   test
		   item))
		   item
		   (if params params "")))

(define (keys:key-vals-hash->target keys key-params)
  (let ((tmp (hash-table-ref/default key-params (vector-ref (car keys) 0) "")))
    (if (> (length keys) 1)
	(for-each (lambda (key)
		    (set! tmp (conc tmp "/" (hash-table-ref/default key-params (vector-ref key 0) ""))))
		  (cdr keys)))
︙
129
130
131
132
133
134
135
136

137
138
139
140
141
142
143

131
132
133
134
135
136
137

138
139
140
141
142
143
144
145








-
+








                 state='reset'
           ORDER BY RANDOM() LIMIT 1);" keytxt)

    (sqlite3:for-each-row
     (lambda (id . rem)
       (set! res (apply vector id rem)))
     tdb
     "SELECT id,action,owner,state,target,name,test,item,creation_time,execution_time FROM tasks_queue WHERE keylock=? ORDER BY execution_time ASC LIMIT 1;" keytxt)
     "SELECT id,action,owner,state,target,name,test,item,params,creation_time,execution_time FROM tasks_queue WHERE keylock=? ORDER BY execution_time ASC LIMIT 1;" keytxt)
    (if res ;; yep, have work to be done
	(begin
	  (sqlite3:execute tdb "UPDATE tasks_queue SET state='inprogress',execution_time=strftime('%s','now') WHERE id=?;"
			   (tasks:task-get-id res))
	  res)
	#f)))
︙
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170

158
159
160
161
162
163
164

165
166
167
168
169
170
171
172








-
+








;;
(define (tasks:get-tasks tdb types states)
  (let ((res '()))
    (sqlite3:for-each-row
     (lambda (id . rem)
       (set! res (cons (apply vector id rem) res)))
     tdb
     (conc "SELECT id,action,owner,state,target,name,test,item,creation_time,execution_time 
     (conc "SELECT id,action,owner,state,target,name,test,item,params,creation_time,execution_time 
               FROM tasks_queue "
               ;; WHERE  
               ;;   state IN " statesstr " AND 
	       ;;   action IN " actionsstr 
	   " ORDER BY creation_time DESC;"))
    res))
︙
215
216
217
218
219
220
221
222
223


224
225
226
227
228
229
230
231
232
233
234


235
236
237
238
239
240
241

217
218
219
220
221
222
223


224
225
226
227
228
229
230
231
232
233
234
235

236
237
238
239
240
241
242
243
244








-
-
+
+










-
+
+








       (set! res (cons (apply vector a rem) res)))
     tdb
     "SELECT id,pid,strftime('%m/%d/%Y %H:%M',datetime(start_time,'unixepoch'),'localtime'),strftime('%m/%d/%Y %H:%M:%S',datetime(last_update,'unixepoch'),'localtime'),hostname,username FROM monitors ORDER BY last_update ASC;")
    (reverse res)
    ))

(define (tasks:tasks->text tasks)
  (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~12a"))
    (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "itempatts") "\n"
  (let ((fmtstr "~10a~10a~10a~12a~20a~12a~12a~12a~10a"))
    (conc (format #f fmtstr "id" "action" "owner" "state" "target" "runname" "testpatts" "itempatts" "params") "\n"
	  (string-intersperse 
	   (map (lambda (task)
		  (format #f fmtstr
			  (tasks:task-get-id     task)
			  (tasks:task-get-action task)
			  (tasks:task-get-owner  task)
			  (tasks:task-get-state  task)
			  (tasks:task-get-target task)
			  (tasks:task-get-name   task)
			  (tasks:task-get-test   task)
			  (tasks:task-get-item   task)))
			  (tasks:task-get-item   task)
			  (tasks:task-get-params task)))
		tasks) "\n"))))
   
(define (tasks:monitors->text-table monitors)
  (let ((fmtstr "~4a~8a~20a~20a~10a~10a"))
    (conc (format #f fmtstr "id" "pid" "start time" "last update" "hostname" "user") "\n"
	  (string-intersperse 
	   (map (lambda (monitor)
︙
281
282
283
284
285
286
287


288
289
290
291
292
293
294

284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299








+
+









;; NOTE: It might be good to add one more layer of checking to ensure
;;       that no task gets run in parallel.

(define (tasks:start-run db tdb task)
  (let ((flags (make-hash-table)))
    (hash-table-set! flags "-rerun" "NOT_STARTED")
    (if (not (string=? (tasks:task-get-params task) ""))
	(hash-table-set! flags "-
    (print "Starting run " task)
    ;; sillyness, just call the damn routine with the task vector and be done with it. FIXME SOMEDAY
    (runs:run-tests db
		    (tasks:task-get-target task)
		    (tasks:task-get-name   task)
		    (tasks:task-get-test   task)
		    (tasks:task-get-item   task)
︙

This page was generated in about 0.107s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00