(use test
(prefix sqlite3 sqlite3:)
posix
;; ulex-netutil rpc
pkts
mailbox
hostinfo
regex
tcp6)
(include "ulex.scm")
;; (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
;; find-or-setup-captain
;; get-all-captain-pkts
;; setup-as-captain
;; get-winning-pkt
;; ping
;; remove-captain-pkt
;; start-server-find-port
;; connect-server
)
(test-begin "addresses")
(test #f #t (not (null? (get-all-ips))))
(test #f #t (string? (get-my-best-address)))
(test-end "addresses")
;;======================================================================
;; Setup
;;======================================================================
(system "rm -rf testulexdb testpkts")
(create-directory "testulexdb" #t)
(create-directory "testpkts" #t)
;;======================================================================
;; Captainship
;;======================================================================
(define *udat1* (make-udat))
(test #f #t (udat? (start-server-find-port *udat1* (+ 4242 (random 5000)))))
(test-begin "captainship")
(test #f #t (list? (get-all-captain-pkts *udat1*)))
(test #f #t (udat? (let ((res (find-or-setup-captain *udat1*)))(print res) res)))
(test-end "captainship")
;; ; (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")
;; ;