changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > demo / examples/db/xdb/tests.lisp

changeset 41: 81b7333f27f8
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 16 Jun 2024 22:15:04 -0400
permissions: -rw-r--r--
description: more examples 
     1 (defpackage :xdb/tests
     2   (:use :cl :rt :obj/db :obj/id :xdb :obj/meta/storable))
     3 
     4 (in-package :xdb/tests)
     5 (defsuite :xdb)
     6 (in-suite :xdb)
     7 
     8 (defparameter *tree* nil)
     9 
    10 (defclass test-doc-non-storable (id)
    11   ((eid :initarg :eid)
    12    (aa :initarg :aa)
    13    (bb :initarg :bb)
    14    (cc :initarg :cc)
    15    (dd :initarg :dd)
    16    (ee :initarg :ee)
    17    (ff :initarg :ff)
    18    (hh :initarg :hh)
    19    (data :initarg :data
    20          :initform (make-hash-table)
    21          :accessor data)
    22    (key :initarg :key
    23         :initform nil
    24         :accessor key)
    25    (type :initarg :type
    26          :initform nil)))
    27 
    28 (defclass test-doc-storable ()
    29   ((eid :initarg :eid)
    30    (aa :initarg :aa)
    31    (bb :initarg :bb)
    32    (cc :initarg :cc)
    33    (dd :initarg :dd)
    34    (ee :initarg :ee)
    35    (ff :initarg :ff)
    36    (hh :initarg :hh)
    37    (data :initarg :data
    38          :initform (make-hash-table)
    39          :accessor data)
    40    (key :initarg :key
    41         :initform nil
    42         :accessor key)
    43    (type :initarg :type
    44          :initform nil))
    45   (:metaclass storable-class))
    46 
    47 (defun make-doc-test (type key data)
    48   (let ((doc-obj (make-instance 'test-doc-storable :key key :type type)))
    49     (dolist (pair data)
    50       (setf (gethash (first pair) (data doc-obj)) (second pair)))
    51     doc-obj))
    52 
    53 (defun test-store-doc (collection times)
    54   (dotimes (i times)
    55     (xdb::store-doc collection
    56                     (make-doc-test
    57                      "Test Doc"
    58                      i
    59                      (list
    60                       (list "id" i)
    61                       (list "eid" i)
    62                       (list "aa" (format nil "~R" (random 51234)))
    63                       (list "bb" (format nil "~R" (random 1234)))
    64                       (list "cc" (format nil "~R" (random 1234)))
    65                       (list "dd" (format nil "~R" (random 1234)))
    66                       (list "ee" (format nil "~R" (random 1234)))
    67                       (list "ff" (format nil "~R" (random 1234)))
    68                       (list "gg" (format nil "~R" (random 1234)))
    69                       (list "hh" (format nil "~R" (random 1234))))))))
    70 
    71 (defun db-test (n)
    72   (let* ((db (make-instance 'xdb :location "/tmp/db-test/"))
    73          (col (add-collection db "test" :load-from-file-p nil)))
    74     (time (test-store-doc col n))
    75     ;; (time (snapshot db))
    76     ;; (time (sum col "eid"))
    77     ;; (time (find-doc col "eid" 50))
    78     ;; (time (sort-collection col))
    79     ))
    80 
    81 (defun test-store-docx (collection times)
    82   (dotimes (i times)
    83 
    84     (xdb::store-doc collection  
    85 
    86                     (make-doc-test 
    87                      "Test Doc"
    88                      i
    89                      (list
    90                       (list "id" i)
    91                       (list "eid" i)
    92                       (list "aa" (random 51234))
    93                       (list "bb" (format nil "~R" (random 1234)))
    94                       (list "cc" (format nil "~R" (random 1234)))
    95                       (list "dd" (format nil "~R" (random 1234)))
    96                       (list "ee" (format nil "~R" (random 1234)))
    97                       (list "ff" (format nil "~R" (random 1234)))
    98                       (list "gg" (format nil "~R" (random 1234)))
    99                       (list "hh" (get-universal-time))))
   100                     )
   101 
   102     (if (equal (mod i 100000) 0)
   103         (sb-ext:gc :full t))))
   104 
   105 (defun test-store-doc-storable-object (collection times)
   106   (dotimes (i times)
   107     (xdb::store-doc collection  
   108                     (make-instance 'test-doc-storable :key i :type "Test Doc"
   109                                    :id i
   110                                    :eid i
   111                                    :aa (random 51234)
   112                                    :bb (format nil "~R" (random 1234))
   113                                    :cc (format nil "~R" (random 1234))
   114                                    :dd (format nil "~R" (random 1234))
   115                                    :ee (format nil "~R" (random 1234))
   116                                    :ff (format nil "~R" (random 1234))
   117                                    :hh (get-universal-time))
   118 
   119                     )
   120 
   121     (if (equal (mod i 100000) 0)
   122         (sb-ext:gc :full t))))
   123 
   124 (defun test-store-doc-non-storable-object (collection times)
   125   (dotimes (i times)
   126     (xdb::store-doc collection  
   127                     (make-instance 'test-doc-non-storable :key i :type "Test Doc"
   128                                    :id i
   129                                    :eid i
   130                                    :aa (random 51234)
   131                                    :bb (format nil "~R" (random 1234))
   132                                    :cc (format nil "~R" (random 1234))
   133                                    :dd (format nil "~R" (random 1234))
   134                                    :ee (format nil "~R" (random 1234))
   135                                    :ff (format nil "~R" (random 1234))
   136                                    :hh (get-universal-time))
   137 
   138                     )
   139 
   140     (if (equal (mod i 100000) 0)
   141         (sb-ext:gc :full t))))
   142 
   143 (defun test-store-doc-hash (collection times)
   144   (dotimes (i times)
   145     (let ((hash (make-hash-table :test 'equal)))
   146       (setf (gethash 'key hash) i)
   147       (setf (gethash "id" hash) i)
   148       (setf (gethash "eid" hash) i)
   149       (setf (gethash "bb" hash) (format nil "~R" (random 1234)))
   150       (setf (gethash "cc" hash) (format nil "~R" (random 1234)))
   151       (setf (gethash "dd" hash) (format nil "~R" (random 1234)))
   152       (setf (gethash "ee" hash) (format nil "~R" (random 1234)))
   153       (setf (gethash "ff" hash) (format nil "~R" (random 1234)))
   154       (setf (gethash "stamp" hash) (get-universal-time))
   155       (xdb::store-doc collection hash))
   156 
   157     (if (equal (mod i 100000) 0)
   158         (sb-ext:gc :full t))))
   159 
   160 
   161 (defun test-store-doc-list (collection times)
   162   (dotimes (i times)
   163     (xdb::store-doc collection (list
   164                                 (list 'key i)
   165                                 (list "id" i)
   166                                 (list "eid" i)
   167                                 (list "aa" (random 51234))
   168                                 (list "bb" (format nil "~R" (random 1234)))
   169                                 (list "cc" (format nil "~R" (random 1234)))
   170                                 (list "dd" (format nil "~R" (random 1234)))
   171                                 (list "ee" (format nil "~R" (random 1234)))
   172                                 (list "ff" (format nil "~R" (random 1234)))
   173                                 (list "gg" (format nil "~R" (random 1234)))
   174                                 (list "stamp" (get-universal-time))))
   175 
   176     (if (equal (mod i 100000) 0)
   177         (sb-ext:gc :full t))))
   178 
   179 (defparameter db (make-instance 'xdb :location "/tmp/db-test/"))
   180 
   181 (defparameter col-hash (add-collection db "test-hash" :load-from-file-p nil))
   182 
   183 (defparameter col-list (add-collection db "test-list" :load-from-file-p nil))
   184 (defparameter col-object (add-collection db "test-object" :load-from-file-p nil))
   185 (defparameter col-object-storable (add-collection db "test-object-storable" :load-from-file-p nil))
   186 
   187 ;;; DB
   188 (deftest db ()
   189   "Test database protocol."
   190   (format t "Hash Test~%")
   191   (format t "Store~%")
   192   (time (test-store-doc-hash col-hash 10000))
   193   (format t "Sum~%")
   194   (time (xdb::sum col-hash :element "id"))
   195   (format t "Find~%")
   196   (time (xdb::find-doc col-hash :test (lambda (doc) (equal (get-val doc "id") 500))))
   197   (format t "Sort~%")
   198   (time (xdb::sort-collection col-hash))
   199   (format t "List Test~%")
   200   (format t "Store~%")
   201   (time (test-store-doc-list col-list 10000))
   202   (format t "Sum~%")
   203   (time (xdb::sum col-list :element "id"))
   204   (format t "Find~%")
   205   (time (xdb::find-doc col-list :test (lambda (doc) (equal (get-val doc "id") 500))))
   206   (format t "Sort~%")
   207   (time (xdb::sort-collection col-list))
   208 
   209 
   210   (format t "Object non storable Test~%")
   211   (format t "Store~%")
   212   (time (test-store-doc-non-storable-object col-object 10000))
   213   (format t "Sum~%")
   214   (time (xdb::sum col-object :element 'id))
   215   (format t "Find~%")
   216   (time (xdb::find-doc col-object :test (lambda (doc) (equal (get-val doc 'id) 500))))
   217   (format t "Sort~%")
   218   (time (xdb::sort-collection col-object))
   219 
   220 
   221   (setf xdb::*fsync-data* nil)
   222   (format t "Object storable Test~%")
   223   (format t "Store~%")
   224   (time (test-store-doc-storable-object col-object-storable 10000))
   225   (format t "Sum~%")
   226   (time (xdb::sum col-object-storable :element 'id))
   227   (format t "Find~%")
   228   (time (xdb::find-doc col-object-storable :test (lambda (doc) (equal (get-val doc 'id) 500))))
   229   (format t "Sort~%")
   230   (time (xdb::sort-collection col-object-storable)))
   231