;;; 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) ))