1.1--- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2+++ b/examples/db/xdb/tests.lisp Sun Jun 16 22:15:04 2024 -0400
1.3@@ -0,0 +1,231 @@
1.4+(defpackage :xdb/tests
1.5+ (:use :cl :rt :obj/db :obj/id :xdb :obj/meta/storable))
1.6+
1.7+(in-package :xdb/tests)
1.8+(defsuite :xdb)
1.9+(in-suite :xdb)
1.10+
1.11+(defparameter *tree* nil)
1.12+
1.13+(defclass test-doc-non-storable (id)
1.14+ ((eid :initarg :eid)
1.15+ (aa :initarg :aa)
1.16+ (bb :initarg :bb)
1.17+ (cc :initarg :cc)
1.18+ (dd :initarg :dd)
1.19+ (ee :initarg :ee)
1.20+ (ff :initarg :ff)
1.21+ (hh :initarg :hh)
1.22+ (data :initarg :data
1.23+ :initform (make-hash-table)
1.24+ :accessor data)
1.25+ (key :initarg :key
1.26+ :initform nil
1.27+ :accessor key)
1.28+ (type :initarg :type
1.29+ :initform nil)))
1.30+
1.31+(defclass test-doc-storable ()
1.32+ ((eid :initarg :eid)
1.33+ (aa :initarg :aa)
1.34+ (bb :initarg :bb)
1.35+ (cc :initarg :cc)
1.36+ (dd :initarg :dd)
1.37+ (ee :initarg :ee)
1.38+ (ff :initarg :ff)
1.39+ (hh :initarg :hh)
1.40+ (data :initarg :data
1.41+ :initform (make-hash-table)
1.42+ :accessor data)
1.43+ (key :initarg :key
1.44+ :initform nil
1.45+ :accessor key)
1.46+ (type :initarg :type
1.47+ :initform nil))
1.48+ (:metaclass storable-class))
1.49+
1.50+(defun make-doc-test (type key data)
1.51+ (let ((doc-obj (make-instance 'test-doc-storable :key key :type type)))
1.52+ (dolist (pair data)
1.53+ (setf (gethash (first pair) (data doc-obj)) (second pair)))
1.54+ doc-obj))
1.55+
1.56+(defun test-store-doc (collection times)
1.57+ (dotimes (i times)
1.58+ (xdb::store-doc collection
1.59+ (make-doc-test
1.60+ "Test Doc"
1.61+ i
1.62+ (list
1.63+ (list "id" i)
1.64+ (list "eid" i)
1.65+ (list "aa" (format nil "~R" (random 51234)))
1.66+ (list "bb" (format nil "~R" (random 1234)))
1.67+ (list "cc" (format nil "~R" (random 1234)))
1.68+ (list "dd" (format nil "~R" (random 1234)))
1.69+ (list "ee" (format nil "~R" (random 1234)))
1.70+ (list "ff" (format nil "~R" (random 1234)))
1.71+ (list "gg" (format nil "~R" (random 1234)))
1.72+ (list "hh" (format nil "~R" (random 1234))))))))
1.73+
1.74+(defun db-test (n)
1.75+ (let* ((db (make-instance 'xdb :location "/tmp/db-test/"))
1.76+ (col (add-collection db "test" :load-from-file-p nil)))
1.77+ (time (test-store-doc col n))
1.78+ ;; (time (snapshot db))
1.79+ ;; (time (sum col "eid"))
1.80+ ;; (time (find-doc col "eid" 50))
1.81+ ;; (time (sort-collection col))
1.82+ ))
1.83+
1.84+(defun test-store-docx (collection times)
1.85+ (dotimes (i times)
1.86+
1.87+ (xdb::store-doc collection
1.88+
1.89+ (make-doc-test
1.90+ "Test Doc"
1.91+ i
1.92+ (list
1.93+ (list "id" i)
1.94+ (list "eid" i)
1.95+ (list "aa" (random 51234))
1.96+ (list "bb" (format nil "~R" (random 1234)))
1.97+ (list "cc" (format nil "~R" (random 1234)))
1.98+ (list "dd" (format nil "~R" (random 1234)))
1.99+ (list "ee" (format nil "~R" (random 1234)))
1.100+ (list "ff" (format nil "~R" (random 1234)))
1.101+ (list "gg" (format nil "~R" (random 1234)))
1.102+ (list "hh" (get-universal-time))))
1.103+ )
1.104+
1.105+ (if (equal (mod i 100000) 0)
1.106+ (sb-ext:gc :full t))))
1.107+
1.108+(defun test-store-doc-storable-object (collection times)
1.109+ (dotimes (i times)
1.110+ (xdb::store-doc collection
1.111+ (make-instance 'test-doc-storable :key i :type "Test Doc"
1.112+ :id i
1.113+ :eid i
1.114+ :aa (random 51234)
1.115+ :bb (format nil "~R" (random 1234))
1.116+ :cc (format nil "~R" (random 1234))
1.117+ :dd (format nil "~R" (random 1234))
1.118+ :ee (format nil "~R" (random 1234))
1.119+ :ff (format nil "~R" (random 1234))
1.120+ :hh (get-universal-time))
1.121+
1.122+ )
1.123+
1.124+ (if (equal (mod i 100000) 0)
1.125+ (sb-ext:gc :full t))))
1.126+
1.127+(defun test-store-doc-non-storable-object (collection times)
1.128+ (dotimes (i times)
1.129+ (xdb::store-doc collection
1.130+ (make-instance 'test-doc-non-storable :key i :type "Test Doc"
1.131+ :id i
1.132+ :eid i
1.133+ :aa (random 51234)
1.134+ :bb (format nil "~R" (random 1234))
1.135+ :cc (format nil "~R" (random 1234))
1.136+ :dd (format nil "~R" (random 1234))
1.137+ :ee (format nil "~R" (random 1234))
1.138+ :ff (format nil "~R" (random 1234))
1.139+ :hh (get-universal-time))
1.140+
1.141+ )
1.142+
1.143+ (if (equal (mod i 100000) 0)
1.144+ (sb-ext:gc :full t))))
1.145+
1.146+(defun test-store-doc-hash (collection times)
1.147+ (dotimes (i times)
1.148+ (let ((hash (make-hash-table :test 'equal)))
1.149+ (setf (gethash 'key hash) i)
1.150+ (setf (gethash "id" hash) i)
1.151+ (setf (gethash "eid" hash) i)
1.152+ (setf (gethash "bb" hash) (format nil "~R" (random 1234)))
1.153+ (setf (gethash "cc" hash) (format nil "~R" (random 1234)))
1.154+ (setf (gethash "dd" hash) (format nil "~R" (random 1234)))
1.155+ (setf (gethash "ee" hash) (format nil "~R" (random 1234)))
1.156+ (setf (gethash "ff" hash) (format nil "~R" (random 1234)))
1.157+ (setf (gethash "stamp" hash) (get-universal-time))
1.158+ (xdb::store-doc collection hash))
1.159+
1.160+ (if (equal (mod i 100000) 0)
1.161+ (sb-ext:gc :full t))))
1.162+
1.163+
1.164+(defun test-store-doc-list (collection times)
1.165+ (dotimes (i times)
1.166+ (xdb::store-doc collection (list
1.167+ (list 'key i)
1.168+ (list "id" i)
1.169+ (list "eid" i)
1.170+ (list "aa" (random 51234))
1.171+ (list "bb" (format nil "~R" (random 1234)))
1.172+ (list "cc" (format nil "~R" (random 1234)))
1.173+ (list "dd" (format nil "~R" (random 1234)))
1.174+ (list "ee" (format nil "~R" (random 1234)))
1.175+ (list "ff" (format nil "~R" (random 1234)))
1.176+ (list "gg" (format nil "~R" (random 1234)))
1.177+ (list "stamp" (get-universal-time))))
1.178+
1.179+ (if (equal (mod i 100000) 0)
1.180+ (sb-ext:gc :full t))))
1.181+
1.182+(defparameter db (make-instance 'xdb :location "/tmp/db-test/"))
1.183+
1.184+(defparameter col-hash (add-collection db "test-hash" :load-from-file-p nil))
1.185+
1.186+(defparameter col-list (add-collection db "test-list" :load-from-file-p nil))
1.187+(defparameter col-object (add-collection db "test-object" :load-from-file-p nil))
1.188+(defparameter col-object-storable (add-collection db "test-object-storable" :load-from-file-p nil))
1.189+
1.190+;;; DB
1.191+(deftest db ()
1.192+ "Test database protocol."
1.193+ (format t "Hash Test~%")
1.194+ (format t "Store~%")
1.195+ (time (test-store-doc-hash col-hash 10000))
1.196+ (format t "Sum~%")
1.197+ (time (xdb::sum col-hash :element "id"))
1.198+ (format t "Find~%")
1.199+ (time (xdb::find-doc col-hash :test (lambda (doc) (equal (get-val doc "id") 500))))
1.200+ (format t "Sort~%")
1.201+ (time (xdb::sort-collection col-hash))
1.202+ (format t "List Test~%")
1.203+ (format t "Store~%")
1.204+ (time (test-store-doc-list col-list 10000))
1.205+ (format t "Sum~%")
1.206+ (time (xdb::sum col-list :element "id"))
1.207+ (format t "Find~%")
1.208+ (time (xdb::find-doc col-list :test (lambda (doc) (equal (get-val doc "id") 500))))
1.209+ (format t "Sort~%")
1.210+ (time (xdb::sort-collection col-list))
1.211+
1.212+
1.213+ (format t "Object non storable Test~%")
1.214+ (format t "Store~%")
1.215+ (time (test-store-doc-non-storable-object col-object 10000))
1.216+ (format t "Sum~%")
1.217+ (time (xdb::sum col-object :element 'id))
1.218+ (format t "Find~%")
1.219+ (time (xdb::find-doc col-object :test (lambda (doc) (equal (get-val doc 'id) 500))))
1.220+ (format t "Sort~%")
1.221+ (time (xdb::sort-collection col-object))
1.222+
1.223+
1.224+ (setf xdb::*fsync-data* nil)
1.225+ (format t "Object storable Test~%")
1.226+ (format t "Store~%")
1.227+ (time (test-store-doc-storable-object col-object-storable 10000))
1.228+ (format t "Sum~%")
1.229+ (time (xdb::sum col-object-storable :element 'id))
1.230+ (format t "Find~%")
1.231+ (time (xdb::find-doc col-object-storable :test (lambda (doc) (equal (get-val doc 'id) 500))))
1.232+ (format t "Sort~%")
1.233+ (time (xdb::sort-collection col-object-storable)))
1.234+
