105 lines
3.4 KiB
Common Lisp
105 lines
3.4 KiB
Common Lisp
;;; cl-scopes/test/test-storage
|
|
|
|
;;;; testing facility for scopes/storage
|
|
|
|
(defpackage :scopes/test-storage
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:config :scopes/config)
|
|
(:core :scopes/core)
|
|
(:folder :scopes/storage/folder)
|
|
(:logging :scopes/logging)
|
|
(:message :scopes/core/message)
|
|
(:msgstore :scopes/storage/msgstore)
|
|
(:shape :scopes/shape)
|
|
(:storage :scopes/storage)
|
|
(:tracking :scopes/storage/tracking)
|
|
(:util :scopes/util)
|
|
(:t :scopes/testing)
|
|
(:alx :alexandria))
|
|
(:export #:run #:run-all #:run-postgres #:run-sqlite)
|
|
(:import-from :scopes/testing #:deftest #:==))
|
|
|
|
(in-package :scopes/test-storage)
|
|
|
|
(defun run-all ()
|
|
(run-sqlite)
|
|
(run-postgres))
|
|
|
|
(defun run-sqlite ()
|
|
(load (t:test-path "config-sqlite" "etc"))
|
|
(let ((t:*test-suite* (t:test-suite "sqlite")))
|
|
(run)))
|
|
|
|
(defun run-postgres ()
|
|
(load (t:test-path "config-postgres" "etc"))
|
|
(let ((t:*test-suite* (t:test-suite "postgres")))
|
|
(run)))
|
|
|
|
(defun run ()
|
|
(core:setup-services)
|
|
(let ((ctx (core:find-service :storage)))
|
|
(test-track ctx)
|
|
(test-msgstore ctx)
|
|
(test-folder ctx)
|
|
(t:show-result)))
|
|
|
|
(deftest test-track (ctx)
|
|
(let ((st (storage:storage ctx))
|
|
cont tr tr2)
|
|
(setf cont (tracking:make-container st))
|
|
(storage:drop-table st :tracks)
|
|
(tracking:create-table cont)
|
|
(setf tr (tracking:make-item cont :t01 :john))
|
|
(== (shape:head tr) '(:t01 :john))
|
|
(== (shape:head-plist tr) '(:username "john" :taskid "t01"))
|
|
(== (shape:data tr) nil)
|
|
(setf (shape:data tr) '(:desc "scopes/storage: queries"))
|
|
(tracking:insert tr)
|
|
(== (tracking:trackid tr) 1)
|
|
(setf tr2 (tracking:get-track cont 1))
|
|
(== (shape:head tr2) '(:t01 :john))
|
|
(== (getf (shape:data tr2) :desc) "scopes/storage: queries")
|
|
))
|
|
|
|
(deftest test-msgstore (ctx)
|
|
(let ((st (storage:storage ctx))
|
|
cont msg pm pm2 pm3 r1)
|
|
(setf cont (msgstore:make-container st))
|
|
(storage:drop-table st :messages)
|
|
(tracking:create-table cont)
|
|
(setf msg (message:create '(:test :data :field) :data '(:info "test data")))
|
|
(setf pm (msgstore:save msg cont))
|
|
(== (tracking:trackid pm) 1)
|
|
(setf pm2 (tracking:get-track cont 1))
|
|
(== (shape:head pm2) '(:test :data :field nil))
|
|
(== (getf (shape:data pm2) :info) "test data")
|
|
(setf pm3 (tracking:query-last cont '(:domain :test)))
|
|
;(util:lgi pm3)
|
|
(msgstore:save pm3 cont)
|
|
(setf (getf (shape:data pm3) :info) "changed")
|
|
(msgstore:save pm3 cont)
|
|
;(setf r1 (tracking:query cont '(:= :domain "test")))
|
|
(setf r1 (tracking:query cont nil))
|
|
(== (length r1) 2)
|
|
))
|
|
|
|
(deftest test-folder (ctx)
|
|
(let ((st (storage:storage ctx))
|
|
cont root f1 f2 f3 r1)
|
|
(setf cont (folder:make-container st))
|
|
(storage:drop-table st :folders)
|
|
(tracking:create-table cont)
|
|
(setf root (folder:root cont))
|
|
(== (tracking:trackid root) 1)
|
|
(== (shape:head-value root :parentid) nil)
|
|
(setf f1 (folder:create :child1 root))
|
|
(== (tracking:trackid f1) 2)
|
|
(== (shape:head-value f1 :parentid) "1")
|
|
(setf (shape:head-value f1 :ref) :dummy-0)
|
|
(tracking:save f1)
|
|
(setf r1 (folder:items root))
|
|
(== (length r1) 1)
|
|
(== (shape:head-value (car r1) :ref) :dummy-0)
|
|
(setf f2 (folder:parent (car r1)))
|
|
(== (tracking:trackid f2) 1)
|
|
))
|