Megatest

Check-in [ff1b962889]
Login
Overview
Comment:Added/modified stuff for mockup
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | remote-run-capability
Files: files | file ages | folders
SHA1: ff1b962889f8a1af1e335abc582a561a5356f5bc
User & Date: mrwellan on 2013-01-08 11:07:43
Other Links: branch diff | manifest | tags
Context
2013-01-08
17:21
More fixes/ideas in the mockup for zmq check-in: fcdbe6448f user: mrwellan tags: remote-run-capability
11:07
Added/modified stuff for mockup check-in: ff1b962889 user: mrwellan tags: remote-run-capability
2013-01-07
20:15
Added missing mockupclientlib file check-in: 7b5c5970ba user: matt tags: trunk
2012-12-19
16:53
yada check-in: c997a36b7c user: mrwellan tags: remote-run-capability
Changes

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