Megatest

run.scm at [b7dc85fea2]
Login

File ulex/tests/run.scm artifact 57deaf9515 part of check-in b7dc85fea2


(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")