This is equivalent to a diff from
ff53dae2a1
to ff1b962889
Modified dashboard-guimonitor.scm
from [04b2273746]
to [2698f99901].
︙ | | |
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
-
-
-
-
-
+
+
+
+
+
-
-
+
+
+
-
-
-
+
+
+
+
|
(megatestdbpath (conc *toppath* "/megatest.db"))
(modtime (max (file-modification-time megatestdbpath)
(file-modification-time monitordbpath))))
;; do stuff here when the db is updated by some other process
(if (> modtime lastmodtime)
(let ((tlst (tasks:get-tasks tdb '() '()))
(mlst (tasks:get-monitors tdb)))
(set! tasksdat tlst)
(set! monitorsdat mlst)
(iup:attribute-set! monitors "VALUE" (tasks:monitors->text-table mlst))
(iup:attribute-set! actions "VALUE" (tasks:tasks->text tlst))
(tasks:process-queue db tdb)
;; (set! tasksdat tlst)
;; (set! monitorsdat mlst)
;; (iup:attribute-set! monitors "VALUE" (tasks:monitors->text-table mlst))
;; (iup:attribute-set! actions "VALUE" (tasks:tasks->text tlst))
;; (tasks:process-queue db tdb)
(set! lastmodtime (max (file-modification-time megatestdbpath)
(file-modification-time monitordbpath)))
(tasks:reset-stuck-tasks tdb)))
(file-modification-time monitordbpath)))
;; (tasks:reset-stuck-tasks tdb)))
))
;; stuff to do every 10 seconds
(if (> (current-seconds) next-touch)
(begin
;; (tasks:process-queue db tdb monitordbpath)
(tasks:monitors-update tdb)
(tasks:reset-stuck-tasks tdb)
(set! monitorsdat (tasks:get-monitors tdb))
;; (tasks:monitors-update tdb)
;; (tasks:reset-stuck-tasks tdb)
(set! monitorsdat (tasks:get-monitors tdb)
)
(set! next-touch (+ (current-seconds) 10))
)))))
(topdialog #f))
(set! topdialog (iup:vbox ;; iup:dialog
#:close_cb (lambda (a)(exit))
#:title "Run Controls"
(iup:vbox
|
︙ | | |
Modified db.scm
from [7a89b7f1fc]
to [5f49a2d10d].
︙ | | |
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
|
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
|
-
+
-
-
+
+
+
+
+
+
+
+
|
(sqlite3:set-busy-handler! db handler)
(if (not dbexists)
(begin
(sqlite3:execute db "CREATE TABLE IF NOT EXISTS log (id INTEGER PRIMARY KEY,event_time TIMESTAMP DEFAULT (strftime('%s','now')),logline TEXT,pwd TEXT,cmdline TEXT,pid INTEGER);")
(sqlite3:execute db (conc "PRAGMA synchronous = 0;"))))
db))
(define (db:log-event . loglst)
(define (db:log-local-event . loglst)
(let ((db (open-logging-db))
(logline (apply conc loglst)))
(let ((logline (apply conc loglst))
(pwd (current-directory))
(cmdline (string-intersperse (argv) " "))
(pid (current-process-id)))
(db:log-event logline pwd cmdline pid)))
(define (db:log-event logline pwd cmdline pid)
(let ((db (open-logging-db)))
(sqlite3:execute db "INSERT INTO log (logline,pwd,cmdline,pid) VALUES (?,?,?,?);" logline (current-directory)(string-intersperse (argv) " ")(current-process-id))
(sqlite3:finalize! db)
logline))
;;======================================================================
;; TODO:
;; put deltas into an assoc list with version numbers
|
︙ | | |
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
|
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
|
-
+
|
(define (db:teststep-set-status! db test-id teststep-name state-in status-in comment logfile)
(debug:print 4 "test-id: " test-id " teststep-name: " teststep-name)
(let* ((tdb (db:open-test-db-by-test-id db test-id))
(state (items:check-valid-items "state" state-in))
(status (items:check-valid-items "status" status-in)))
(if (or (not state)(not status))
(debug:print 0 "WARNING: Invalid " (if status "status" "state")
(debug:print 3 "WARNING: Invalid " (if status "status" "state")
" value \"" (if status state-in status-in) "\", update your validvalues section in megatest.config"))
(if tdb
(begin
(sqlite3:execute
tdb
"INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);"
test-id teststep-name state-in status-in (current-seconds) (if comment comment "") (if logfile logfile ""))
|
︙ | | |
Added testzmq/mockupclientlib.scm version [e845ef89d4].
|
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
32
33
34
35
36
37
38
39
40
|
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
|
(define sub (make-socket 'sub))
(define push (make-socket 'push))
(socket-option-set! sub 'subscribe cname)
(connect-socket sub "tcp://localhost:5563")
(connect-socket push "tcp://localhost:5564")
(define (dbaccess cname cmd var val #!key (numtries 20))
(let* ((msg (conc cname ":" cmd ":" (if val (conc var " " val) var)))
(res #f)
(mtx1 (make-mutex))
(do-access (lambda ()
(print "Sending msg: " msg)
(send-message push msg)
(print "Message " msg " sent")
(print "Client " cname " waiting for response to " msg)
(print "Client " cname " received address " (receive-message* sub))
(mutex-lock! mtx1)
(set! res (receive-message* sub))
(mutex-unlock! mtx1))))
(let ((th1 (make-thread do-access "do access"))
(th2 (make-thread (lambda ()
(let ((result #f))
(mutex-lock! mtx1)
(set! result res)
(mutex-unlock! mtx1)
(thread-sleep! 5)
(if (not result)
(if (> numtries 0)
(begin
(print "WARNING: access timed out for " cname ", trying again. Trys remaining=" numtries)
(dbaccess cname cmd var val numtries: (- numtries 1)))
(begin
(print "ERROR: dbaccess timed out. Exiting")
(exit)))))
"timeout thread"))))
(thread-start! th1)
(thread-start! th2)
(thread-join! th1)
res)))
|
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |
Modified testzmq/mockupserver.scm
from [71a381625f]
to [d8f479a6ef].
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
|
-
-
+
+
|
;; pub/sub with envelope address
;; Note that if you don't insert a sleep, the server will crash with SIGPIPE as soon
;; as a client disconnects. Also a remaining client may receive tons of
;; messages afterward.
(use zmq srfi-18 sqlite3)
(define pub (make-socket 'pub))
(define pull (make-socket 'pull))
(define cname "server")
(define total-db-accesses 0)
(define start-time (current-seconds))
(bind-socket pub "tcp://*:5563")
(bind-socket pull "tcp://*:5564")
(bind-socket pub "tcp://*:6563")
(bind-socket pull "tcp://*:6564")
(define (open-db)
(let* ((dbpath "mockup.db")
(dbexists (file-exists? dbpath))
(db (open-database dbpath)) ;; (never-give-up-open-db dbpath))
(handler (make-busy-timeout 10)))
(set-busy-handler! db handler)
|
︙ | | |
Added testzmq/random.scm version [ff0bb26c19].
|
1
2
3
4
5
6
7
8
|
+
+
+
+
+
+
+
+
|
(use posix)
(randomize (inexact->exact (current-seconds)))
(define low (string->number (cadr (argv))))
(define hi (string->number (caddr (argv))))
(print (+ low (random (- hi low))))
|
| | | | | | |
Modified testzmq/testmockup.sh
from [15deaa0e30]
to [8727defc64].
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
|
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
|
+
-
+
-
-
+
+
|
#!/bin/bash
rm -f mockup.db
echo Compiling mockupserver.scm and mockupclient.scm
csc random.scm
csc mockupserver.scm
csc mockupclient.scm
echo Starting server
./mockupserver &
sleep 1
echo Starting clients
for i in a b c d e f g h i j k l m n o p q s t u v w x y z;
for i in a b c d e; # f g h i j k l m n o p q s t u v w x y z;
do
for k in a b;
do
for j in 0 1 2 3 4 5 6 7 8 9;
do
waittime=`random 0 60`
runtime=`random 5 120`
waittime=`./random 0 60`
runtime=`./random 5 120`
echo "Starting client $i$k$j with waittime $waittime and runtime $runtime"
(sleep $waittime;./mockupclient $i$k$j $runtime) &
done
done
done
wait
|
︙ | | |