Changeset 2584

Show
Ignore:
Timestamp:
02/21/08 07:41:43 (9 months ago)
Author:
hans
Message:

Cleanup in indices - Remove &ALLOW-OTHER-KEYS, add more error checking. Thanks to Klaus Unger for reporting

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved
  • trunk/bknr/datastore/src/data/object.lisp

    r2528 r2584  
    128128  ((id :initarg :id :reader store-object-id 
    129129       :index-type unique-index 
    130        :index-initargs (:test #'eql :rehash-size 10000 :size 10000
     130       :index-initargs (:test #'eql
    131131       :index-reader store-object-with-id :index-values all-store-objects 
    132132       :index-mapvalues map-store-objects)) 
  • trunk/bknr/datastore/src/indices/category-index.lisp

    r2529 r2584  
    121121  (:default-initargs :test #'equal)) 
    122122 
    123 (defmethod initialize-instance :after ((index category-index) &key (tree-test #'eql) &allow-other-keys
     123(defmethod initialize-instance :after ((index category-index) &key (tree-test #'eql)
    124124  (with-slots (tree) index 
    125125    (setf tree (make-category-tree :test tree-test)))) 
  • trunk/bknr/datastore/src/indices/indexed-class.lisp

    r2508 r2584  
    9393    (nreverse result))) 
    9494 
    95 (defmethod direct-slot-definition-class ((class indexed-class) &key index index-type &allow-other-keys
     95(defmethod direct-slot-definition-class ((class indexed-class) &key index index-type
    9696  (if (or index index-type) 
    9797      'index-direct-slot-definition 
     
    234234  (reinitialize-class-indices class)) 
    235235 
     236(defun validate-index-declaration (class indices) 
     237  (dolist (index indices) 
     238    (when (and (getf (cdr index) :index) 
     239               (getf (cdr index) :index-type)) 
     240      (error "Can't have both :INDEX and :INDEX-TYPE in index ~A of ~A" (car index) class)))) 
     241 
     242(defmethod initialize-instance :before ((class indexed-class) &key class-indices) 
     243  (validate-index-declaration class class-indices)) 
     244 
     245(defmethod reinitialize-instance :before ((class indexed-class) &key class-indices) 
     246  (validate-index-declaration class class-indices)) 
     247 
    236248;;; avoid late instantiation 
    237249 
    238250#+(or allegro cmu openmcl sbcl) 
    239 (defmethod initialize-instance :after ((class indexed-class) &key &allow-other-keys
     251(defmethod initialize-instance :after ((class indexed-class) &key
    240252  (compute-class-indices class (indexed-class-index-definitions class)) 
    241253  (reinitialize-class-indices class)) 
    242254 
    243255#+(or allegro cmu openmcl sbcl) 
    244 (defmethod reinitialize-instance :after ((class indexed-class) &key &allow-other-keys
     256(defmethod reinitialize-instance :after ((class indexed-class) &key
    245257  (compute-class-indices class (indexed-class-index-definitions class)) 
    246258  (reinitialize-class-indices class)) 
     
    259271                                (index-holder-index old-holder)))))))) 
    260272 
    261 (defmethod reinitialize-instance :before ((class indexed-class) &key &allow-other-keys
     273(defmethod reinitialize-instance :before ((class indexed-class) &key
    262274  (setf (indexed-class-old-indices class) (indexed-class-indices class) 
    263275        (indexed-class-indices class) nil)) 
     
    312324(defvar *indices-remove-p* t) 
    313325 
    314 (defmethod make-instance :around ((class indexed-class) &rest initargs) 
    315   (declare (ignore initargs)) 
     326(defmethod make-instance :around ((class indexed-class) &key) 
    316327  (let* ((*in-make-instance-p* t) 
    317328         (object (call-next-method)) 
  • trunk/bknr/datastore/src/indices/indices.lisp

    r2580 r2584  
    109109  ()) 
    110110 
    111 (defmethod initialize-instance :after ((index string-unique-index) &key (test #'equal) &allow-other-keys
     111(defmethod initialize-instance :after ((index string-unique-index) &key (test #'equal)
    112112  (with-slots (hash-table) index 
    113113    (setf hash-table (make-hash-table :test test)))) 
     
    165165                       :reader class-index-index-superclasses))) 
    166166   
    167 (defmethod initialize-instance :after ((index class-index) &key index-superclasses &allow-other-keys
     167(defmethod initialize-instance :after ((index class-index) &key index-superclasses
    168168  (setf (slot-value index 'index-superclasses) 
    169169        index-superclasses)) 
     
    232232   (array :initarg :array :accessor array-index-array))) 
    233233 
    234 (defmethod initialize-instance :after ((index array-index) &key slots dimensions &allow-other-keys
     234(defmethod initialize-instance :after ((index array-index) &key slots dimensions
    235235  (setf (array-index-array index) (make-array dimensions :initial-element nil) 
    236236        (array-index-slot-names index) slots)) 
     
    321321              :accessor skip-list-index-index-nil))) 
    322322 
    323 (defmethod initialize-instance :after ((index skip-list-index) &key  
    324                                        slots index-nil &allow-other-keys) 
     323(defmethod initialize-instance :after ((index skip-list-index) &key slots index-nil) 
    325324  (unless (<= (length slots) 1) 
    326325    (error "Can not create slot-index with more than one slot.")) 
     
    375374 
    376375(defmethod cursor-next ((slc skip-list-cursor) &optional eoc) 
     376  (declare (ignore eoc)) 
    377377  (sl-cursor-next slc)) 
    378378 
    379379(defmethod cursor-prev ((slc skip-list-cursor) &optional eoc) 
     380  (declare (ignore eoc)) 
    380381  (sl-cursor-prev slc)) 
    381382 
  • trunk/bknr/datastore/src/indices/tutorial.lisp

    r1673 r2584  
    556556 value, else slots with NIL value are treated as unbound slots."))) 
    557557 
    558 (defmethod initialize-instance :after 
    559     ((index slot-index) &key (test #'eql) slots index-nil 
    560      &allow-other-keys) 
     558(defmethod initialize-instance :after ((index slot-index) &key (test #'eql) slots index-nil) 
    561559  (unless (<= (length slots) 1) 
    562560    (error "Can not create slot-index with more than one slot."))