(use test (prefix sqlite3 sqlite3:) posix ulex-netutil rpc pkts mailbox)
;; (use (prefix ulex ulex:))
(if (file-exists? "ulex.scm")
(load "ulex.scm")
(load "../ulex.scm"))
(use trace)
(trace-call-sites #t)
(import ulex) ;; (import (prefix ulex ulex:))
(trace
;; send-message
;; receive-message
;; std-peer-handler
;; work-queue-add
;; deliver-response
;; finalize-all-db-handles
;; area-dbhandles
;; save-dbh
;; process-db-queries
;; dbdat-dbh
;; get-best-server
;; calc-server-score
;; ping
;; full-ping
;; register-node
;; calc-server-score
;; update-known-servers
;; request
;; get-dbh
;; update-stats
;; process-db-queries
;; deliver-response
)
(test-begin "misc")
(test #f #t (string? (get-my-best-address)))
(test-end "misc")
;;======================================================================
;; Setup
;;======================================================================
(system "rm -rf testulexdb testpkts")
(create-directory "testulexdb" #t)
(create-directory "testpkts" #t)
(define *area* (make-area dbdir: "testulexdb" pktsdir: "testpkts"))
(define *port* #f)
;;======================================================================
;; Ulex-db
;;======================================================================
(test-begin "ulex-db")
(test #f #t (equal? (area-dbdir *area*) "testulexdb"))
(test #f #t (thread? (thread-start! (make-thread (lambda ()(launch *area*)) "server"))))
(thread-sleep! 1)
(test #f 1 (update-known-servers *area*))
(test #f #t (list? (get-all-server-pkts *area*)))
(test #f (area-myaddr *area*) (cadr (ping *area* (area-myaddr *area*)(area-port *area*))))
(let loop ((count 10))
(if (null? (get-all-server-pkts *area*))
(if (> count 0)
(begin
(thread-sleep! 1)
(print "waiting for server pkts")
(loop (- count 1))))))
(test #f #t (let ((spkts (get-all-server-pkts *area*)))
(and (list spkts) (> (length spkts) 0))))
(test #f #t (begin (register-batch
*area*
'dbwrite ;; this is the call type
`((dbinitsql . ("CREATE TABLE IF NOT EXISTS messages (id INTEGER PRIMARY KEY, message TEXT, author TEXT, msg_time INTEGER);"))
(savemsg . "INSERT INTO messages (message,author) VALUES (?,?)")
;; (readmsg . "SELECT * FROM messages WHERE author=?;")
))
#t))
(test #f #t (calldat? (get-rentry *area* 'dbinitsql)))
(define cdat1 (get-rentry *area* 'dbinitsql))
(test #f #t (list? (get-best-server *area* "test.db" 'savemsg)))
(test #f #t (eq? 'dbwrite (calldat-ctype cdat1)))
(test #f #t (list? (get-rsql *area* 'dbinitsql)))
(test #f #t (dbdat? (open-db *area* "test.db")))
(test #f #t (dbdat? (let ((dbh (get-dbh *area* "test.db")))
(save-dbh *area* "test.db" dbh)
dbh)))
(test #f #t (dbdat? (let ((dbh (get-dbh *area* "test.db")))
dbh)))
;(test #f '(#t "db write submitted" #t) (call *area* "test.db" 'savemsg '("Test message!" "matt")))
(test #f #t (call *area* "test.db" 'savemsg '("Test message!" "matt")))
;;(thread-sleep! 15);; server needs time to process the request (it is non-blocking)
;; (test #f #t (shutdown *area*))
;; (test #f 0 (calc-server-score *area* "test.db" (area-pktid *area*)))
(test #f #t (list? (get-best-server *area* "test.db" (area-pktid *area*))))
(define *best-server* (car (get-best-server *area* "test.db" (area-pktid *area*))))
(pp *best-server*)
(define *server-pkt* (hash-table-ref/default (area-hosts *area*) (area-pktid *area*) #f))
(define *server-ip* (alist-ref 'ipaddr *server-pkt*))
(define *server-port* (any->number (alist-ref 'port *server-pkt*)))
(test #f #t (list? (ping *area* *server-ip* *server-port*)))
(test #f #t (process-db-queries *area* "test.db"))
(test #f #f (process-db-queries *area* "junk.db"))
;; (test #f #t (cadr (full-ping *area* *server-pkt*)))
(test-end "ulex-db")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(test-begin "faux-mtdb")
;; pre-clean
#;(for-each (lambda (dir)
(if (directory-exists? dir)
(system (conc "/bin/rm -rf ./"dir)))
(system (conc "/bin/mkdir -p ./"dir))
)
'("faux-mtdb" "faux-mtdb-pkts"))
(let* ((area *area*) ;; (make-area dbdir: "faux-mtdb" pktsdir: "faux-mtdb-pkts"))
(specfile "tests/mt-spec.sexpr")
(dbname "faux-mt.db"))
;; (launch area)
(initialize-area-calls-from-specfile area specfile)
(let* ((target-name "a/b/c/d")
(insert-result (call area dbname 'new-target (list target-name)))
(test-target-id (caar (call area dbname 'target-name->target-id (list target-name))))
(test-target-name (caar (call area dbname 'target-id->target-name (list 1)))))
(test #f #t insert-result)
(test #f 1 test-target-id )
(test #f target-name test-target-name )
)
(test #f #t (list? (get-best-server *area* "test.db" 'savemsg)))
(thread-sleep! 5)
(test #f #t (begin (shutdown area) #t)))
(test #f #t (process-db-queries *area* "test.db"))
(test #f #f (process-db-queries *area* "junk.db"))
;; thought experiment - read cursors
;; (let* ((cursor (call area dbname 'get-target-names '())))
;; (let loop ((row (cursor)))
;; (cond
;; ((not row) #t)
;; (else
;; (print "ROW IS "row)
;; (loop (cursor))))))
(test-end "faux-mtdb")
;;======================================================================
;; Portlogger tests
;;======================================================================
;; (test-begin "portlogger")
;;
;; (test #f #f (begin (pl-open-run-close (lambda (db b)(pl-get-prev-used-port db)) *area*) #f))
;; (test #f #f (pl-open-run-close (lambda (db b)(pl-get-port-state db 1234567)) *area*))
;; (test #f #f (number? (pl-open-run-close (lambda (db b)(pl-take-port db 123456)) *area*)))
;; (test #f #t (number? (let ((port (pl-open-run-close pl-find-port *area*)))
;; (set! *port* port)
;; port)))
;; (test #f 1 (pl-open-run-close pl-release-port *port*))
;; (test #f "released" (pl-open-run-close
;; (lambda (db)
;; (sqlite3:first-result db "select state from ports where port=?" *port*))))
;;
;; (test-end "portlogger")