mas01cr@511: (in-package "SB-ADB")
mas01cr@511: 
mas01cr@661: (load-shared-object "../../libaudioDB.so.0.0")
mas01cr@661: 
mas01cr@511: (define-symbol-macro %default-query-args nil)
mas01cr@511: (defmacro with-default-query-args (args &body body &environment env)
mas01cr@511:   (let ((current-args (macroexpand '%default-query-args env)))
mas01cr@511:     `(symbol-macrolet ((%default-query-args ,(append args current-args)))
mas01cr@511:        ,@body)))
mas01cr@511: 
mas01cr@511: (defmacro with-query-result-assertions 
mas01cr@511:     ((query db &rest query-args) &body body &environment env)
mas01cr@511:   (let ((results (gensym "RESULTS"))
mas01cr@511:         (default-args (macroexpand '%default-query-args env)))
mas01cr@511:     `(let* ((,results (query ,query ,db ,@query-args ,@default-args))
mas01cr@511:             (length (length ,results)))
mas01cr@511:        (flet ((%present (list)
mas01cr@511:                 (find-if (lambda (r)
mas01cr@511:                            (and
mas01cr@674:                             (string= (first list) (result-ikey r))
mas01cr@511:                             (< (abs (- (second list) (result-distance r))) 1e-4)
mas01cr@511:                             (= (third list) (result-qpos r))
mas01cr@511:                             (= (fourth list) (result-ipos r))))
mas01cr@511:                          ,results)))
mas01cr@511:          (declare (ignorable #'%present))
mas01cr@511:          (macrolet ((present (&rest forms)
mas01cr@511:                       `(and ,@(loop for f in forms collect `(%present ',f)))))
mas01cr@511:            ,@(loop for b in body collect `(assert ,b)))))))
mas01cr@511: 
mas01cr@511: (defmacro with-asserted-query-results ((query db &rest query-args) &body body)
mas01cr@511:   `(with-query-result-assertions (,query ,db ,@query-args)
mas01cr@511:      (= length ,(length body))
mas01cr@511:      (present ,@body)))
mas01cr@511: 
mas01cr@634: (defmacro assert-erroneous (form)
mas01cr@634:   `(handler-case ,form
mas01cr@634:      (error ())
mas01cr@634:      (:no-error (&rest values) 
mas01cr@634:        (error "No error: returned ~S" values))))
mas01cr@634: 
mas01cr@511: (declaim (optimize debug))
mas01cr@511: 
mas01cr@511: (defun test-0003 ()
mas01cr@511:   (let ((datum (make-datum "testfeature" '((1d0)))))
mas01cr@511:     (with-adb (db "testdb.0003" :direction :output :if-exists :supersede)
mas01cr@511:       (l2norm db)
mas01cr@511:       (insert datum db)
mas01cr@511:       (with-asserted-query-results
mas01cr@511:           (datum db :npoints 10 :accumulation :db :distance :dot-product)
mas01cr@511:         ("testfeature" 1 0 0)))))
mas01cr@511: 
mas01cr@511: (defun test-0004 ()
mas01cr@511:   (let ((feature (make-datum "testfeature" '((0d0 1d0) (1d0 0d0))))
mas01cr@511:         (query05 (make-datum "testquery" '((0d0 0.5d0))))
mas01cr@511:         (query50 (make-datum "testquery" '((0.5d0 0d0)))))
mas01cr@511:     (with-adb (db "testdb.0004" :direction :output :if-exists :supersede)
mas01cr@511:       (l2norm db)
mas01cr@511:       (insert feature db)
mas01cr@511:       (with-default-query-args (:accumulation :db :distance :dot-product)
mas01cr@511:         (with-asserted-query-results (query05 db :npoints 10)
mas01cr@511:           ("testfeature" 0.5 0 0) ("testfeature" 0 0 1))
mas01cr@511:         (with-asserted-query-results (query05 db :npoints 1)
mas01cr@511:           ("testfeature" 0.5 0 0))
mas01cr@511:         (with-asserted-query-results (query50 db :npoints 10)
mas01cr@511:           ("testfeature" 0.5 0 1) ("testfeature" 0 0 0))
mas01cr@511:         (with-asserted-query-results (query50 db :npoints 1)
mas01cr@511:           ("testfeature" 0.5 0 1))))))
mas01cr@511: 
mas01cr@511: (defun test-0010 ()
mas01cr@511:   (let ((feature01 (make-datum "testfeature01" '((0d0 1d0))))
mas01cr@511:         (feature10 (make-datum "testfeature10" '((1d0 0d0))))
mas01cr@511:         (query05 (make-datum "testquery" '((0d0 0.5d0))))
mas01cr@511:         (query50 (make-datum "testquery" '((0.5d0 0d0)))))
mas01cr@511:     (with-adb (db "testdb.0010" :direction :output :if-exists :supersede)
mas01cr@511:       (insert feature01 db)
mas01cr@511:       (insert feature10 db)
mas01cr@511:       (l2norm db)
mas01cr@511:       (with-default-query-args
mas01cr@511:           (:accumulation :per-track :ntracks 10 :npoints 10 :distance :euclidean-normed)
mas01cr@511:         (with-asserted-query-results (query05 db)
mas01cr@511:           ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))
mas01cr@511:         (with-asserted-query-results (query05 db :radius 5)
mas01cr@511:           ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))
mas01cr@511:         (with-asserted-query-results (query05 db :radius 1)
mas01cr@511:           ("testfeature01" 0 0 0))
mas01cr@511:         (with-asserted-query-results (query50 db)
mas01cr@511:           ("testfeature01" 2 0 0) ("testfeature10" 0 0 0))
mas01cr@511:         (with-asserted-query-results (query50 db :radius 5)
mas01cr@511:           ("testfeature01" 2 0 0) ("testfeature10" 0 0 0))
mas01cr@511:         (with-asserted-query-results (query50 db :radius 1)
mas01cr@511:           ("testfeature10" 0 0 0))))))
mas01cr@511: 
mas01cr@511: (defun test-0031 ()
mas01cr@511:   (let ((feature01 (make-datum "testfeature01" '((0d0 1d0))))
mas01cr@511:         (feature10 (make-datum "testfeature10" '((1d0 0d0))))
mas01cr@511:         (query05 (make-datum "testquery" '((0d0 0.5d0)))))
mas01cr@511:     (with-adb (db "testdb.0031" :direction :output :if-exists :supersede)
mas01cr@511:       (insert feature01 db)
mas01cr@511:       (insert feature10 db)
mas01cr@511:       (l2norm db)
mas01cr@511:       (with-default-query-args 
mas01cr@511:           (:accumulation :per-track :ntracks 10 :npoints 10 :distance :euclidean-normed)
mas01cr@511:         (with-asserted-query-results (query05 db)
mas01cr@511:           ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))
mas01cr@511:         (with-asserted-query-results (query05 db :include-keys ()))
mas01cr@511:         (with-asserted-query-results (query05 db :include-keys '("testfeature01"))
mas01cr@511:           ("testfeature01" 0 0 0))
mas01cr@511:         (with-asserted-query-results (query05 db :include-keys '("testfeature10"))
mas01cr@511:           ("testfeature10" 2 0 0))
mas01cr@511:         (with-asserted-query-results (query05 db :include-keys '("testfeature10" "testfeature01"))
mas01cr@511:           ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))
mas01cr@511: 
mas01cr@511:         (with-asserted-query-results (query05 db :exclude-keys '("testfeature10" "testfeature01")))        
mas01cr@511: 
mas01cr@511:         (with-asserted-query-results (query05 db :exclude-keys '("testfeature01"))
mas01cr@511:           ("testfeature10" 2 0 0))
mas01cr@511:         (with-asserted-query-results (query05 db :exclude-keys '("testfeature10"))
mas01cr@511:           ("testfeature01" 0 0 0))
mas01cr@511:         (with-asserted-query-results (query05 db :exclude-keys ())
mas01cr@511:           ("testfeature01" 0 0 0) ("testfeature10" 2 0 0))))))
mas01cr@511: 
mas01cr@511: (defun test-0036 ()
mas01cr@511:   (let ((feature01 (make-datum "testfeature01" '((0d0 1d0) (1d0 0d0))))
mas01cr@511:         (feature10 (make-datum "testfeature10" '((1d0 0d0) (0d0 1d0))))
mas01cr@511:         (query05 (make-datum "testquery" '((0d0 0.5d0))))
mas01cr@511:         (query50 (make-datum "testquery" '((0.5d0 0d0)))))
mas01cr@511:     (with-adb (db "testdb.0036" :direction :output :if-exists :supersede)
mas01cr@511:       (insert feature01 db)
mas01cr@511:       (insert feature10 db)
mas01cr@511:       (l2norm db)
mas01cr@511:       (with-default-query-args 
mas01cr@511:           (:accumulation :per-track :ntracks 10 :distance :euclidean-normed)
mas01cr@511:         (dolist (npoints '(10 2 5))
mas01cr@511:           (with-asserted-query-results (query05 db :npoints npoints)
mas01cr@511:             ("testfeature01" 0 0 0) ("testfeature01" 2 0 1)
mas01cr@511:             ("testfeature10" 0 0 1) ("testfeature10" 2 0 0)))
mas01cr@511:         (with-asserted-query-results (query05 db :npoints 1)
mas01cr@511:           ("testfeature01" 0 0 0) ("testfeature10" 0 0 1))
mas01cr@511:         (dolist (npoints '(10 2 5))
mas01cr@511:           (with-asserted-query-results (query50 db :npoints npoints)
mas01cr@511:             ("testfeature01" 0 0 1) ("testfeature01" 2 0 0)
mas01cr@511:             ("testfeature10" 0 0 0) ("testfeature10" 2 0 1)))
mas01cr@511:         (with-asserted-query-results (query50 db :npoints 1)
mas01cr@511:           ("testfeature01" 0 0 1) ("testfeature10" 0 0 0))))))
mas01cr@634: 
mas01cr@634: (defun test-0048 ()
mas01cr@634:   (let ((datum1 (make-datum "testfeature01" '((0d0 0.5d0) (0.5d0 0d0))
mas01cr@634:                             :times (coerce '(0d0 1d0 1d0 2d0) '(vector double-float))))
mas01cr@634:         (datum2 (make-datum "testfeature10" '((0.5d0 0d0) (0d0 0.5d0) (0.5d0 0d0))
mas01cr@634:                             :times (coerce '(0d0 2d0 2d0 3d0 3d0 4d0) '(vector double-float)))))
mas01cr@634:     (with-adb (db "testdb.0048" :direction :output :if-exists :supersede)
mas01cr@634:       (insert datum1 db)
mas01cr@634:       (insert datum2 db)
mas01cr@634:       (l2norm db)
mas01cr@634:       (assert-erroneous (retrieve "testfeature" db))
mas01cr@634:       (assert (equalp (retrieve "testfeature01" db) datum1))
mas01cr@634:       (assert (equalp (retrieve "testfeature10" db) datum2)))))
mas01cr@661: 
mas01cr@661: (defun run-tests ()
mas01cr@661:   (test-0003)
mas01cr@661:   (test-0004)
mas01cr@661:   (test-0010)
mas01cr@661:   (test-0031)
mas01cr@661:   (test-0036)
mas01cr@661:   (test-0048))