Megatest

Check-in [cf97950521]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Switched rcp test to use sql-de-lite
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: cf979505211459c4f64ef479ba3d06f4f7d733b1
User & Date: matt on 2015-12-07 22:26:52
Other Links: branch diff | manifest | tags
Context
2015-12-08
08:44
Merged fork check-in: ca3c827888 user: mrwellan tags: v1.60
2015-12-07
22:26
Switched rcp test to use sql-de-lite check-in: cf97950521 user: matt tags: v1.60
21:32
Added script to run client and a little help to header of rpctest.scm check-in: 3c88ad926f user: matt tags: v1.60
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified rpctest/rpctest.scm from [9aa9c89e7f] to [900250564a]. 

1
2
3
4
5
6
7
8

9
10
11
12
13
14
15
16
17

























18
19
20
21
22
23
24

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
41
42
43
44
45
46
47
48
49








-
+









+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








;;;; rpc-demo.scm
;;;; Simple database server / client

;;; start server thusly: ./rpctest server test.db
;;; you will need to init test.db:
;;; sqlite3 test.db "CREATE TABLE foo (id INTEGER PRIMARY KEY, var TEXT, val TEXT);"

(require-extension (srfi 18) extras tcp rpc sqlite3)
(require-extension (srfi 18) extras tcp rpc sql-de-lite)

;;; Common things

(define total-queries 0)
(define start-time (current-seconds))

(define operation (string->symbol (car (command-line-arguments))))
(define param (cadr (command-line-arguments)))
(print "Operation: " operation ", param: " param)

;; have a pool of db's to pick from
(define *dbpool* '())
(define *pool-mutex* (make-mutex))

(define (get-db)
  (mutex-lock! *pool-mutex*)
  (if (null? *dbpool*)
      (begin
	(mutex-unlock! *pool-mutex*)
	(let ((db (open-database param)))
	  (set-busy-handler! db (busy-timeout 10000))
	  (exec (sql db "PRAGMA synchronous=0;"))
	  db))
      (let ((res (car *dbpool*)))
	(set! *dbpool* (cdr *dbpool*))
	(mutex-unlock! *pool-mutex*)
	res)))

(define (return-db db)
  (mutex-lock! *pool-mutex*)
  (set! *dbpool* (cons db *dbpool* ))
  (let ((res (length *dbpool*)))
    (mutex-unlock! *pool-mutex*)
    res))

(define rpc:listener
  (if (eq? operation 'server)
      (tcp-listen (rpc:default-server-port))
      (tcp-listen 0)))

;; Start server thread
︙
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49











50

51
52
53
54
55
56
57

58
59
60
61
62
63
64










65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84








-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+

+









(define (server)
  (rpc:publish-procedure!
   'change-response-port
   (lambda (port)
     (rpc:default-server-port port))
   #f)
  (let ((db (open-database param)))
    (set-finalizer! db finalize!)
    (rpc:publish-procedure!
     'query
     (lambda (sql callback)
       (set! total-queries (+ total-queries 1))
       (print "Executing query '" sql "' ...")
       (for-each-row
	callback
	db sql)
  ;;(let ((db  (get-db))(open-database param)))
  ;; (set-finalizer! db finalize!)
  (rpc:publish-procedure!
   'query
   (lambda (sqlstmt callback)
     (set! total-queries (+ total-queries 1))
     (print "Executing query '" sqlstmt "' ...")
     (let ((db (get-db)))
       (query (for-each-row
	       callback)
	      (sql db sqlstmt))
       (print "Query rate: " (/ total-queries (/ (- (current-seconds) start-time) 60)) " per minute")
       (print "num dbs: " (return-db db))
       )))
  (thread-join! rpc:server))

;;; Client side

(define (callback1 . columns)
  (let loop ((c columns) (i 0))
︙
67
68
69
70
71
72
73
74


75
76
77
78
79
80
81

94
95
96
97
98
99
100

101
102
103
104
105
106
107
108
109








-
+
+









(define (client)
  ((rpc:procedure 'change-response-port "localhost")
   (tcp-listener-port rpc:listener))
  ((rpc:procedure 'query "localhost") param callback1)
  (rpc:publish-procedure! 'callback2 callback2)
  ((rpc:procedure 'query "localhost") param callback2)
  (pp callback2-results))
  (pp callback2-results)
  (rpc:close-connection! "localhost" (rpc:default-server-port)))

;;; Run it

(if (eq? operation 'server)
    (server)
    (client))

Modified rpctest/run-client.sh from [9287190e12] to [7217b9abad]. 

1
2
3
4
5

6
7
8
9
10
11
12

1
2
3
4

5
6
7
8
9
10
11
12





-
+








#!/bin/bash


while ./rpctest client "insert into foo (var,val) values ($RANDOM,$RANDOM);";do
    numrows=$(./rpctest client "select * from foo;"|wc -l)
    numrows=$(./rpctest client "select count(id) from foo;") # |wc -l)
    deletefrom=$RANDOM
    echo "numrows=$numrows, deletefrom=$deletefrom"
    if [[ $numrows -gt 300 ]];then
	echo "numrows=$numrows, deletefrom=$deletefrom"
	./rpctest client "delete from foo where var > $deletefrom;"
    fi
done

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