[rucksack-cvs] CVS rucksack
alemmens
alemmens at common-lisp.net
Thu Aug 31 15:50:28 UTC 2006
Update of /project/rucksack/cvsroot/rucksack
In directory clnet:/tmp/cvs-serv9397
Added Files:
test-index-1a.lisp test-index-1b.lisp
Removed Files:
example-1.lisp
Log Message:
Write test case for slots with redefined indexes. This also tests
the default method for UPDATE-PERSISTENT-INSTANCE-FOR-REDEFINED-CLASS.
--- /project/rucksack/cvsroot/rucksack/test-index-1a.lisp 2006/08/31 15:50:27 NONE
+++ /project/rucksack/cvsroot/rucksack/test-index-1a.lisp 2006/08/31 15:50:27 1.1
;; $Id: test-index-1a.lisp,v 1.1 2006/08/31 15:50:27 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)
(defparameter *hacker-rucksack* #p"/tmp/rucksack/hackers/")
(with-rucksack (*rucksack* *hacker-rucksack*)
(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 (*rucksack* *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 *rucksack* 'hacker #'print))))
(defun show-hackers ()
(with-rucksack (*rucksack* *hacker-rucksack*)
(with-transaction ()
(print "Hackers indexed by object id.")
(rucksack-map-class *rucksack* 'hacker #'print)
(print "Hackers indexed by name.")
(rucksack-map-slot *rucksack* 'hacker 'name #'print)
(print "Hackers indexed by hacker-id.")
(rucksack-map-slot *rucksack* 'hacker 'id #'print)
(print "Lisp hackers.")
(rucksack-map-class *rucksack* 'lisp-hacker #'print)
(print "Non-lisp hackers.")
(rucksack-map-class *rucksack* 'hacker #'print
:include-subclasses nil)
(print "Hacker object ids.")
(rucksack-map-class *rucksack* 'hacker #'print
:id-only t))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Example output
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#|
TEST-RS 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
TEST-RS 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/test-index-1b.lisp 2006/08/31 15:50:28 NONE
+++ /project/rucksack/cvsroot/rucksack/test-index-1b.lisp 2006/08/31 15:50:28 1.1
;; $Id: test-index-1b.lisp,v 1.1 2006/08/31 15:50:27 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 (*rucksack* *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 (*rucksack* *hacker-rucksack*)
(with-transaction ()
(print "Hackers by age.")
(rucksack-map-slot *rucksack* 'hacker 'age
(lambda (hacker)
(format t "~&~A has age ~D.~%"
(name hacker)
(age hacker)))))))
More information about the rucksack-cvs
mailing list