[rucksack-cvs] CVS rucksack/tests
alemmens
alemmens at common-lisp.net
Wed Jan 23 15:49:07 UTC 2008
Update of /project/rucksack/cvsroot/rucksack/tests
In directory clnet:/tmp/cvs-serv2612/tests
Added Files:
test-index-1a.lisp test-index-1b.lisp
test-schema-update-1a.lisp test-schema-update-1b.lisp
test-schema-update-1c.lisp test.lisp
Log Message:
Move all test files to the new tests directory.
--- /project/rucksack/cvsroot/rucksack/tests/test-index-1a.lisp 2008/01/23 15:49:07 NONE
+++ /project/rucksack/cvsroot/rucksack/tests/test-index-1a.lisp 2008/01/23 15:49:07 1.1
;; $Id: test-index-1a.lisp,v 1.1 2008/01/23 15:49:07 alemmens Exp $
(in-package :rucksack-test)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Indexing example
;;;
;;; To run this example:
;;; - compile and load this file
;;; - (IN-PACKAGE :RUCKSACK-TEST)
;;; - (CREATE-HACKERS)
;;; - (SHOW-HACKERS)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter *hackers* '("David" "Jim" "Peter" "Thomas"
"Arthur" "Jans" "Klaus" "James" "Martin"))
(defun random-elt (list)
(elt list (random (length list))))
(eval-when (:compile-toplevel :load-toplevel :execute)
;; NOTE: The EVAL-WHEN above is necessary to ensure that the compiler
;; 'knows about' the HACKER class when it compiles the PRINT-OBJECT method
;; for HACKER. We could avoid this by splitting this file into two:
;; the first one would contain the class definitions, and the second
;; would contain everything else (especially methods that specialize on one
;; of the classes defined in the first one).
(defparameter *hacker-rucksack* #p"/tmp/rucksack/hackers/")
(with-rucksack (rs *hacker-rucksack* :if-exists :supersede)
(with-transaction ()
;; We define some persistent classes with indexed slots.
;; So we must wrap the class definition in a WITH-RUCKSACK,
;; otherwise the indexes can't be built.
(defclass hacker ()
((id :initform (gensym "HACKER-")
:reader hacker-id
:index :symbol-index
:unique t)
(name :initform (random-elt *hackers*)
:accessor name
:index :case-insensitive-string-index))
(:metaclass persistent-class)
(:index t))
(defclass lisp-hacker (hacker)
()
(:metaclass persistent-class)
(:index t)))))
(defmethod print-object ((hacker hacker) stream)
(print-unreadable-object (hacker stream :type t)
(format stream "~S called ~S"
(hacker-id hacker)
(name hacker))))
(defun create-hackers ()
(with-rucksack (rs *hacker-rucksack*)
;; Fill the rucksack with some hackers.
(with-transaction ()
(loop repeat 20
do (make-instance 'hacker))
(loop repeat 10
do (make-instance 'lisp-hacker))
(rucksack-map-class rs 'hacker #'print))))
(defun show-hackers ()
(with-rucksack (rs *hacker-rucksack*)
(with-transaction ()
(print "Hackers indexed by object id.")
(rucksack-map-class rs 'hacker #'print)
(print "Hackers indexed by name.")
(rucksack-map-slot rs 'hacker 'name #'print)
(print "Hackers indexed by hacker-id.")
(rucksack-map-slot rs 'hacker 'id #'print)
(print "Lisp hackers.")
(rucksack-map-class rs 'lisp-hacker #'print)
(print "Non-lisp hackers.")
(rucksack-map-class rs 'hacker #'print
:include-subclasses nil)
(print "Hacker object ids.")
(rucksack-map-class rs 'hacker #'print
:id-only t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Example output
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#|
RS-TEST 3 > (create-hackers)
#<HACKER #:HACKER-9234 called "Martin">
#<HACKER #:HACKER-9235 called "Martin">
#<HACKER #:HACKER-9236 called "Martin">
#<HACKER #:HACKER-9237 called "Jim">
#<HACKER #:HACKER-9238 called "Thomas">
#<HACKER #:HACKER-9239 called "David">
#<HACKER #:HACKER-9240 called "Thomas">
#<HACKER #:HACKER-9241 called "Jim">
#<HACKER #:HACKER-9242 called "Martin">
#<HACKER #:HACKER-9243 called "Jim">
#<HACKER #:HACKER-9244 called "Peter">
#<HACKER #:HACKER-9245 called "Jim">
#<HACKER #:HACKER-9246 called "Thomas">
#<HACKER #:HACKER-9247 called "Jans">
#<HACKER #:HACKER-9248 called "Peter">
#<HACKER #:HACKER-9249 called "Peter">
#<HACKER #:HACKER-9250 called "Arthur">
#<HACKER #:HACKER-9251 called "Thomas">
#<HACKER #:HACKER-9252 called "James">
#<HACKER #:HACKER-9253 called "Martin">
#<LISP-HACKER #:HACKER-9254 called "Jans">
#<LISP-HACKER #:HACKER-9255 called "Martin">
#<LISP-HACKER #:HACKER-9256 called "Thomas">
#<LISP-HACKER #:HACKER-9257 called "Klaus">
#<LISP-HACKER #:HACKER-9258 called "David">
#<LISP-HACKER #:HACKER-9259 called "Thomas">
#<LISP-HACKER #:HACKER-9260 called "David">
#<LISP-HACKER #:HACKER-9261 called "James">
#<LISP-HACKER #:HACKER-9262 called "Peter">
#<LISP-HACKER #:HACKER-9263 called "Peter">
NIL
T
RS-TEST 4 > (show-hackers)
"Hackers indexed by object id."
#<HACKER #:HACKER-9234 called "Martin">
#<HACKER #:HACKER-9235 called "Martin">
#<HACKER #:HACKER-9236 called "Martin">
#<HACKER #:HACKER-9237 called "Jim">
#<HACKER #:HACKER-9238 called "Thomas">
#<HACKER #:HACKER-9239 called "David">
#<HACKER #:HACKER-9240 called "Thomas">
#<HACKER #:HACKER-9241 called "Jim">
#<HACKER #:HACKER-9242 called "Martin">
#<HACKER #:HACKER-9243 called "Jim">
#<HACKER #:HACKER-9244 called "Peter">
#<HACKER #:HACKER-9245 called "Jim">
#<HACKER #:HACKER-9246 called "Thomas">
#<HACKER #:HACKER-9247 called "Jans">
#<HACKER #:HACKER-9248 called "Peter">
#<HACKER #:HACKER-9249 called "Peter">
#<HACKER #:HACKER-9250 called "Arthur">
#<HACKER #:HACKER-9251 called "Thomas">
#<HACKER #:HACKER-9252 called "James">
#<HACKER #:HACKER-9253 called "Martin">
#<LISP-HACKER #:HACKER-9254 called "Jans">
#<LISP-HACKER #:HACKER-9255 called "Martin">
#<LISP-HACKER #:HACKER-9256 called "Thomas">
#<LISP-HACKER #:HACKER-9257 called "Klaus">
#<LISP-HACKER #:HACKER-9258 called "David">
#<LISP-HACKER #:HACKER-9259 called "Thomas">
#<LISP-HACKER #:HACKER-9260 called "David">
#<LISP-HACKER #:HACKER-9261 called "James">
#<LISP-HACKER #:HACKER-9262 called "Peter">
#<LISP-HACKER #:HACKER-9263 called "Peter">
"Hackers indexed by name."
#<HACKER #:HACKER-9250 called "Arthur">
#<LISP-HACKER #:HACKER-9260 called "David">
#<LISP-HACKER #:HACKER-9258 called "David">
#<HACKER #:HACKER-9239 called "David">
#<LISP-HACKER #:HACKER-9261 called "James">
#<HACKER #:HACKER-9252 called "James">
#<LISP-HACKER #:HACKER-9254 called "Jans">
#<HACKER #:HACKER-9247 called "Jans">
#<HACKER #:HACKER-9245 called "Jim">
#<HACKER #:HACKER-9243 called "Jim">
#<HACKER #:HACKER-9241 called "Jim">
#<HACKER #:HACKER-9237 called "Jim">
#<LISP-HACKER #:HACKER-9257 called "Klaus">
#<LISP-HACKER #:HACKER-9255 called "Martin">
#<HACKER #:HACKER-9253 called "Martin">
#<HACKER #:HACKER-9242 called "Martin">
#<HACKER #:HACKER-9236 called "Martin">
#<HACKER #:HACKER-9235 called "Martin">
#<HACKER #:HACKER-9234 called "Martin">
#<LISP-HACKER #:HACKER-9263 called "Peter">
#<LISP-HACKER #:HACKER-9262 called "Peter">
#<HACKER #:HACKER-9249 called "Peter">
#<HACKER #:HACKER-9248 called "Peter">
#<HACKER #:HACKER-9244 called "Peter">
#<LISP-HACKER #:HACKER-9259 called "Thomas">
#<LISP-HACKER #:HACKER-9256 called "Thomas">
#<HACKER #:HACKER-9251 called "Thomas">
#<HACKER #:HACKER-9246 called "Thomas">
#<HACKER #:HACKER-9240 called "Thomas">
#<HACKER #:HACKER-9238 called "Thomas">
"Hackers indexed by hacker-id."
#<HACKER #:HACKER-9234 called "Martin">
#<HACKER #:HACKER-9235 called "Martin">
#<HACKER #:HACKER-9236 called "Martin">
#<HACKER #:HACKER-9237 called "Jim">
#<HACKER #:HACKER-9238 called "Thomas">
#<HACKER #:HACKER-9239 called "David">
#<HACKER #:HACKER-9240 called "Thomas">
#<HACKER #:HACKER-9241 called "Jim">
#<HACKER #:HACKER-9242 called "Martin">
#<HACKER #:HACKER-9243 called "Jim">
#<HACKER #:HACKER-9244 called "Peter">
#<HACKER #:HACKER-9245 called "Jim">
#<HACKER #:HACKER-9246 called "Thomas">
#<HACKER #:HACKER-9247 called "Jans">
#<HACKER #:HACKER-9248 called "Peter">
#<HACKER #:HACKER-9249 called "Peter">
#<HACKER #:HACKER-9250 called "Arthur">
#<HACKER #:HACKER-9251 called "Thomas">
#<HACKER #:HACKER-9252 called "James">
#<HACKER #:HACKER-9253 called "Martin">
#<LISP-HACKER #:HACKER-9254 called "Jans">
#<LISP-HACKER #:HACKER-9255 called "Martin">
#<LISP-HACKER #:HACKER-9256 called "Thomas">
#<LISP-HACKER #:HACKER-9257 called "Klaus">
#<LISP-HACKER #:HACKER-9258 called "David">
#<LISP-HACKER #:HACKER-9259 called "Thomas">
#<LISP-HACKER #:HACKER-9260 called "David">
#<LISP-HACKER #:HACKER-9261 called "James">
#<LISP-HACKER #:HACKER-9262 called "Peter">
#<LISP-HACKER #:HACKER-9263 called "Peter">
"Lisp hackers."
#<LISP-HACKER #:HACKER-9254 called "Jans">
#<LISP-HACKER #:HACKER-9255 called "Martin">
#<LISP-HACKER #:HACKER-9256 called "Thomas">
#<LISP-HACKER #:HACKER-9257 called "Klaus">
#<LISP-HACKER #:HACKER-9258 called "David">
#<LISP-HACKER #:HACKER-9259 called "Thomas">
#<LISP-HACKER #:HACKER-9260 called "David">
#<LISP-HACKER #:HACKER-9261 called "James">
#<LISP-HACKER #:HACKER-9262 called "Peter">
#<LISP-HACKER #:HACKER-9263 called "Peter">
"Non-lisp hackers."
#<HACKER #:HACKER-9234 called "Martin">
#<HACKER #:HACKER-9235 called "Martin">
#<HACKER #:HACKER-9236 called "Martin">
#<HACKER #:HACKER-9237 called "Jim">
#<HACKER #:HACKER-9238 called "Thomas">
#<HACKER #:HACKER-9239 called "David">
#<HACKER #:HACKER-9240 called "Thomas">
#<HACKER #:HACKER-9241 called "Jim">
#<HACKER #:HACKER-9242 called "Martin">
#<HACKER #:HACKER-9243 called "Jim">
#<HACKER #:HACKER-9244 called "Peter">
#<HACKER #:HACKER-9245 called "Jim">
#<HACKER #:HACKER-9246 called "Thomas">
#<HACKER #:HACKER-9247 called "Jans">
#<HACKER #:HACKER-9248 called "Peter">
#<HACKER #:HACKER-9249 called "Peter">
#<HACKER #:HACKER-9250 called "Arthur">
#<HACKER #:HACKER-9251 called "Thomas">
#<HACKER #:HACKER-9252 called "James">
#<HACKER #:HACKER-9253 called "Martin">
"Hacker object ids."
36
65
69
73
78
83
88
92
96
100
104
109
113
117
122
126
130
135
139
144
148
160
164
168
173
177
181
185
189
193
NIL
T
|#
--- /project/rucksack/cvsroot/rucksack/tests/test-index-1b.lisp 2008/01/23 15:49:07 NONE
+++ /project/rucksack/cvsroot/rucksack/tests/test-index-1b.lisp 2008/01/23 15:49:07 1.1
;; $Id: test-index-1b.lisp,v 1.1 2008/01/23 15:49:07 alemmens Exp $
(in-package :rs-test)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Class redefinition example
;;;
;;; To run this example:
;;; - First run the indexing example in test-index-1a.lisp.
;;; - Compile and load this file
;;; This will change the class definition of HACKER.
;;; Because of this change, Rucksack will remove some slot indexes and
;;; create (and fill) other slot indexes.
;;; - (SHOW-HACKERS)
;;; Notice that "Hackers indexed by hacker-id." now doesn't list any hackers,
;;; because the ID index was removed.
;;; - (SHOW-HACKERS-BY-AGE)
;;; This will print the hackers sorted by age. It shows that:
;;; (1) the existing hackers all got a new age slot, initialized by
;;; UPDATE-PERSISTENT-INSTANCE-FOR-REDEFINED-CLASS to a random
;;; number according to their initform
;;; (2) a new index has been created for the new age slot
;;; (3) the index has been filled with the new values for the age slot.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(with-rucksack (rs *hacker-rucksack*)
(with-transaction ()
;; For classes that may change during program development, you should
;; wrap all class definitions in a WITH-RUCKSACK to make sure that
;; the corresponding schemas and indexes are updated correctly.
;; In this case we redefine the HACKER class: we remove the index for
;; the ID slot, and we add a new AGE slot (with an index).
(defclass hacker ()
((id :initform (gensym "HACKER-")
:reader hacker-id)
(name :initform (random-elt *hackers*)
:accessor name
:index :case-insensitive-string-index)
(age :initform (random 100)
:accessor age
:index :number-index))
(:metaclass persistent-class)
(:index t))))
(defun show-hackers-by-age ()
(with-rucksack (rs *hacker-rucksack*)
(with-transaction ()
(print "Hackers by age.")
(rucksack-map-slot rs 'hacker 'age
(lambda (hacker)
(format t "~&~A has age ~D.~%"
(name hacker)
(age hacker)))))))
--- /project/rucksack/cvsroot/rucksack/tests/test-schema-update-1a.lisp 2008/01/23 15:49:07 NONE
+++ /project/rucksack/cvsroot/rucksack/tests/test-schema-update-1a.lisp 2008/01/23 15:49:07 1.1
;; $Id: test-schema-update-1a.lisp,v 1.1 2008/01/23 15:49:07 alemmens Exp $
(in-package :rucksack-test-schema-update)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Schema updates and UPDATE-INSTANCE-FOR-REDEFINED-CLASS, part 1 of 3
;;;
;;; After compiling and loading this file, evaluate:
;;; - (in-package :rucksack-test-schema-update)
;;; - (test-1)
;;;
;;; Then move on to test-schema-update-1b.lisp.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter *names* '(john dick mary jane peter ronald))
;;
;; Initial class definition of PERSON
;;
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *dir* #P"/tmp/rucksack/schema-update/")
(with-rucksack (rs *dir* :if-exists :supersede)
(with-transaction ()
(defclass person ()
((name :initarg :name
:initform (elt *names* (random (length *names*)))
:reader name)
(age :initarg :age
:initform (random 100)
:reader age))
(:metaclass persistent-class)
(:index t)))))
(defmethod print-object ((person person) stream)
(print-unreadable-object (person stream :type t)
(format stream "#~D ~A with age ~D"
(object-id person)
(name person)
(age person))))
(defun test-1 ()
;; Create some persons.
(with-rucksack (rs *dir*)
(with-transaction ()
[25 lines skipped]
--- /project/rucksack/cvsroot/rucksack/tests/test-schema-update-1b.lisp 2008/01/23 15:49:07 NONE
+++ /project/rucksack/cvsroot/rucksack/tests/test-schema-update-1b.lisp 2008/01/23 15:49:07 1.1
[131 lines skipped]
--- /project/rucksack/cvsroot/rucksack/tests/test-schema-update-1c.lisp 2008/01/23 15:49:07 NONE
+++ /project/rucksack/cvsroot/rucksack/tests/test-schema-update-1c.lisp 2008/01/23 15:49:07 1.1
[301 lines skipped]
--- /project/rucksack/cvsroot/rucksack/tests/test.lisp 2008/01/23 15:49:07 NONE
+++ /project/rucksack/cvsroot/rucksack/tests/test.lisp 2008/01/23 15:49:07 1.1
[735 lines skipped]
More information about the rucksack-cvs
mailing list