From 232823a1f163cebeafdab20ea2eb3f2da9645185 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 29 Dec 2014 12:11:09 -0500 Subject: [PATCH] lisp/emacs-lisp/eieio*.el: Reduce object header to 1 slot * lisp/emacs-lisp/eieio-core.el (eieio--with-scoped-class): Use let-binding. (object): Remove first (constant) slot; rename second to `class-tag'. (eieio--object-class-object, eieio--object-class-name): New funs to replace eieio--object-class. (eieio--class-object, eieio--class-p): New functions. (same-class-fast-p): Make it a defsubst, change its implementation to check the class objects rather than their names. (eieio-object-p): Rewrite. (eieio-defclass): Adjust the object initialization according to the new object layout. (eieio--scoped-class): Declare it returns a class object (not a class name any more). Adjust calls accordingly (along with calls to eieio--with-scoped-class). (eieio--slot-name-index): Rename from eieio-slot-name-index and change its class arg to be a class object. Adjust callers accordingly. (eieio-slot-originating-class-p): Make its start-class arg a class object. Adjust all callers. (eieio--initarg-to-attribute): Rename from eieio-initarg-to-attribute. Make its `class' arg a class object. Adjust all callers. * lisp/emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): Use eieio--slot-name-index rather than eieio-slot-name-index. * lisp/emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects additionally to class names. * test/automated/eieio-test-methodinvoke.el (eieio-test-method-store): Adjust to new semantics of eieio--scoped-class. (eieio-test-match): Improve error feedback. --- lisp/ChangeLog | 28 +++++ lisp/emacs-lisp/eieio-base.el | 3 +- lisp/emacs-lisp/eieio-core.el | 131 ++++++++++++++-------- lisp/emacs-lisp/eieio-custom.el | 15 +-- lisp/emacs-lisp/eieio.el | 43 +++---- test/ChangeLog | 13 +++ test/automated/eieio-test-methodinvoke.el | 6 +- 7 files changed, 161 insertions(+), 78 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1a0383814cd..209c833fbe3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,31 @@ +2014-12-29 Stefan Monnier + + * emacs-lisp/eieio.el (child-of-class-p): Make it accept class objects + additionally to class names. + + * emacs-lisp/eieio-core.el (eieio--with-scoped-class): Use let-binding. + (object): Remove first (constant) slot; rename second to `class-tag'. + (eieio--object-class-object, eieio--object-class-name): New funs + to replace eieio--object-class. + (eieio--class-object, eieio--class-p): New functions. + (same-class-fast-p): Make it a defsubst, change its implementation + to check the class objects rather than their names. + (eieio-object-p): Rewrite. + (eieio-defclass): Adjust the object initialization according to the new + object layout. + (eieio--scoped-class): Declare it returns a class object (not a class + name any more). Adjust calls accordingly (along with calls to + eieio--with-scoped-class). + (eieio--slot-name-index): Rename from eieio-slot-name-index and change + its class arg to be a class object. Adjust callers accordingly. + (eieio-slot-originating-class-p): Make its start-class arg a class + object. Adjust all callers. + (eieio--initarg-to-attribute): Rename from eieio-initarg-to-attribute. + Make its `class' arg a class object. Adjust all callers. + + * emacs-lisp/eieio-base.el (eieio-persistent-validate/fix-slot-value): + Use eieio--slot-name-index rather than eieio-slot-name-index. + 2014-12-23 Stefan Monnier * emacs-lisp/eieio.el (make-instance): Simplify by not adding an object diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index 8a09dac2dff..e841ed664c0 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -290,7 +290,8 @@ constructor functions are considered valid. Second, any text properties will be stripped from strings." (cond ((consp proposed-value) ;; Lists with something in them need special treatment. - (let ((slot-idx (eieio-slot-name-index class nil slot)) + (let ((slot-idx (eieio--slot-name-index (eieio--class-v class) + nil slot)) (type nil) (classtype nil)) (setq slot-idx (- slot-idx diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 299df8db378..924886c5ba1 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -101,17 +101,14 @@ default setting for optimization purposes.") "A stack of the classes currently in scope during method invocation.") (defun eieio--scoped-class () - "Return the class currently in scope, or nil." + "Return the class object currently in scope, or nil." (car-safe eieio--scoped-class-stack)) (defmacro eieio--with-scoped-class (class &rest forms) "Set CLASS as the currently scoped class while executing FORMS." (declare (indent 1)) - `(unwind-protect - (progn - (push ,class eieio--scoped-class-stack) - ,@forms) - (pop eieio--scoped-class-stack))) + `(let ((eieio--scoped-class-stack (cons ,class eieio--scoped-class-stack))) + ,@forms)) ;;; ;; Field Accessors @@ -169,8 +166,18 @@ from the default.") Stored outright without modifications or stripping."))) (eieio--define-field-accessors object - (-unused-0 ;;Constant slot, set to `object'. - (class "class struct defining OBJ"))) + ;; `class-tag' holds a symbol, which is not the class name, but is instead + ;; properly prefixed as an internal EIEIO thingy and which holds the class + ;; object/struct in its `symbol-value' slot. + ((class-tag "tag containing the class struct"))) + +(defsubst eieio--object-class-object (obj) + (symbol-value (eieio--object-class-tag obj))) + +(defsubst eieio--object-class-name (obj) + ;; FIXME: Most uses of this function should be changed to use + ;; eieio--object-class-object instead! + (eieio--class-symbol (eieio--object-class-object obj))) ;; FIXME: The constants below should have an `eieio-' prefix added!! (defconst eieio--method-static 0 "Index into :static tag on a method.") @@ -202,22 +209,35 @@ Stored outright without modifications or stripping."))) (t `(,type ,obj)))) (signal 'wrong-type-argument (list ',type ,obj)))) -(defmacro eieio--class-v (class) +(defmacro eieio--class-v (class) ;Use a macro, so it acts as a GV place. "Internal: Return the class vector from the CLASS symbol." (declare (debug t)) ;; No check: If eieio gets this far, it has probably been checked already. `(get ,class 'eieio-class-definition)) +(defsubst eieio--class-object (class) + "Return the class object." + (if (symbolp class) (eieio--class-v class) class)) + +(defsubst eieio--class-p (class) + "Return non-nil if CLASS is a valid class object." + (condition-case nil + (eq (aref class 0) 'defclass) + (error nil))) + (defsubst class-p (class) "Return non-nil if CLASS is a valid class vector. -CLASS is a symbol." +CLASS is a symbol." ;FIXME: Is it a vector or a symbol? ;; this new method is faster since it doesn't waste time checking lots of ;; things. (condition-case nil (eq (aref (eieio--class-v class) 0) 'defclass) (error nil))) -(defun eieio-class-name (class) "Return a Lisp like symbol name for CLASS." +(defun eieio-class-name (class) + "Return a Lisp like symbol name for CLASS." + ;; FIXME: What's a "Lisp like symbol name"? + ;; FIXME: CLOS returns a symbol, but the code returns a string. (eieio--check-type class-p class) ;; I think this is supposed to return a symbol, but to me CLASS is a symbol, ;; and I wanted a string. Arg! @@ -231,9 +251,10 @@ CLASS is a symbol." (defmacro eieio-class-children-fast (class) "Return child classes to CLASS with no check." `(eieio--class-children (eieio--class-v ,class))) -(defmacro same-class-fast-p (obj class) - "Return t if OBJ is of class-type CLASS with no error checking." - `(eq (eieio--object-class ,obj) ,class)) +(defsubst same-class-fast-p (obj class-name) + "Return t if OBJ is of class-type CLASS-NAME with no error checking." + ;; (eq (eieio--object-class-name obj) class) + (eq (eieio--object-class-object obj) (eieio--class-object class-name))) (defmacro class-constructor (class) "Return the symbol representing the constructor of CLASS." @@ -289,10 +310,11 @@ Return nil if that option doesn't exist." (defsubst eieio-object-p (obj) "Return non-nil if OBJ is an EIEIO object." - (condition-case nil - (and (eq (aref obj 0) 'object) - (class-p (eieio--object-class obj))) - (error nil))) + (and (arrayp obj) + (condition-case nil + (eq (aref (eieio--object-class-object obj) 0) 'defclass) + (error nil)))) + (defalias 'object-p 'eieio-object-p) (defsubst class-abstract-p (class) @@ -648,6 +670,9 @@ See `defclass' for more information." ;; FIXME: We should move more of eieio-defclass into the ;; defclass macro so we don't have to use `eval' and require ;; `gv' at run-time. + ;; FIXME: The defmethod above only defines a part of the generic + ;; function, but the define-setter below affects the whole + ;; generic function! (eval `(gv-define-setter ,acces (eieio--store eieio--object) (list 'eieio-oset eieio--object '',name eieio--store))))) @@ -765,9 +790,15 @@ See `defclass' for more information." ;; Create the cached default object. (let ((cache (make-vector (+ (length (eieio--class-public-a newc)) (eval-when-compile eieio--object-num-slots)) - nil))) - (aset cache 0 'object) - (setf (eieio--object-class cache) cname) + nil)) + ;; We don't strictly speaking need to use a symbol, but the old + ;; code used the class's name rather than the class's object, so + ;; we follow this preference for using a symbol, which is probably + ;; convenient to keep the printed representation of such Elisp + ;; objects readable. + (tag (intern (format "eieio-class-tag--%s" cname)))) + (set tag newc) + (setf (eieio--object-class-tag cache) tag) (let ((eieio-skip-typecheck t)) ;; All type-checking has been done to our satisfaction ;; before this call. Don't waste our time in this call.. @@ -1164,7 +1195,7 @@ IMPL is the symbol holding the method implementation." (list method local-args)) ;; We do have an object. Make sure it is the right type. - (if (not (child-of-class-p (eieio--object-class (car local-args)) + (if (not (child-of-class-p (eieio--object-class-object (car local-args)) class)) ;; If not the right kind of object, call no applicable @@ -1177,7 +1208,7 @@ IMPL is the symbol holding the method implementation." (eieio-generic-call-key eieio--method-primary) (eieio-generic-call-arglst local-args) ) - (eieio--with-scoped-class class + (eieio--with-scoped-class (eieio--class-v class) (apply impl local-args))))))) (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) @@ -1291,7 +1322,7 @@ INSTANCE is the object being referenced. SLOTNAME is the offending slot. If the slot is ok, return VALUE. Argument FN is the function calling this verifier." (if (and (eq value eieio-unbound) (not eieio-skip-typecheck)) - (slot-unbound instance (eieio--object-class instance) slotname fn) + (slot-unbound instance (eieio--object-class-name instance) slotname fn) value)) @@ -1302,8 +1333,8 @@ Argument FN is the function calling this verifier." (eieio--check-type (or eieio-object-p class-p) obj) (eieio--check-type symbolp slot) (if (class-p obj) (eieio-class-un-autoload obj)) - (let* ((class (if (class-p obj) obj (eieio--object-class obj))) - (c (eieio-slot-name-index class obj slot))) + (let* ((class (if (class-p obj) obj (eieio--object-class-name obj))) + (c (eieio--slot-name-index (eieio--class-v class) obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. @@ -1325,8 +1356,8 @@ Argument FN is the function calling this verifier." Fills in OBJ's SLOT with its default value." (eieio--check-type (or eieio-object-p class-p) obj) (eieio--check-type symbolp slot) - (let* ((cl (if (eieio-object-p obj) (eieio--object-class obj) obj)) - (c (eieio-slot-name-index cl obj slot))) + (let* ((cl (if (eieio-object-p obj) (eieio--object-class-name obj) obj)) + (c (eieio--slot-name-index (eieio--class-v cl) obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. @@ -1361,22 +1392,24 @@ Fills in OBJ's SLOT with its default value." Fills in OBJ's SLOT with VALUE." (eieio--check-type eieio-object-p obj) (eieio--check-type symbolp slot) - (let ((c (eieio-slot-name-index (eieio--object-class obj) obj slot))) + (let* ((class (eieio--object-class-object obj)) + (c (eieio--slot-name-index class obj slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. (if (setq c - (eieio-class-slot-name-index (eieio--object-class obj) slot)) + (eieio-class-slot-name-index (eieio--class-symbol class) slot)) ;; Oset that slot. (progn - (eieio-validate-class-slot-value (eieio--object-class obj) c value slot) - (aset (eieio--class-class-allocation-values (eieio--class-v (eieio--object-class obj))) + (eieio-validate-class-slot-value (eieio--class-symbol class) + c value slot) + (aset (eieio--class-class-allocation-values class) c value)) ;; See oref for comment on `slot-missing' (slot-missing obj slot 'oset value) ;;(signal 'invalid-slot-name (list (eieio-object-name obj) slot)) ) - (eieio-validate-slot-value (eieio--object-class obj) c value slot) + (eieio-validate-slot-value (eieio--class-symbol class) c value slot) (aset obj c value)))) (defun eieio-oset-default (class slot value) @@ -1384,8 +1417,8 @@ Fills in OBJ's SLOT with VALUE." Fills in the default value in CLASS' in SLOT with VALUE." (eieio--check-type class-p class) (eieio--check-type symbolp slot) - (eieio--with-scoped-class class - (let* ((c (eieio-slot-name-index class nil slot))) + (eieio--with-scoped-class (eieio--class-v class) + (let* ((c (eieio--slot-name-index (eieio--class-v class) nil slot))) (if (not c) ;; It might be missing because it is a :class allocated slot. ;; Let's check that info out. @@ -1413,7 +1446,7 @@ Fills in the default value in CLASS' in SLOT with VALUE." "Return non-nil if START-CLASS is the first class to define SLOT. This is for testing if the class currently in scope is the class that defines SLOT so that we can protect private slots." - (let ((par (eieio-class-parents-fast start-class)) + (let ((par (eieio--class-parent start-class)) (ret t)) (if (not par) t @@ -1423,7 +1456,7 @@ so that we can protect private slots." (setq par (cdr par))) ret))) -(defun eieio-slot-name-index (class obj slot) +(defun eieio--slot-name-index (class obj slot) "In CLASS for OBJ find the index of the named SLOT. The slot is a symbol which is installed in CLASS by the `defclass' call. OBJ can be nil, but if it is an object, and the slot in question @@ -1432,7 +1465,7 @@ scoped class. If SLOT is the value created with :initarg instead, reverse-lookup that name, and recurse with the associated slot value." ;; Removed checks to outside this call - (let* ((fsym (gethash slot (eieio--class-symbol-hashtable (eieio--class-v class)))) + (let* ((fsym (gethash slot (eieio--class-symbol-hashtable class))) (fsi (car fsym))) (if (integerp fsi) (cond @@ -1442,7 +1475,7 @@ reverse-lookup that name, and recurse with the associated slot value." (eieio--scoped-class) (or (child-of-class-p class (eieio--scoped-class)) (and (eieio-object-p obj) - (child-of-class-p class (eieio--object-class obj))))) + (child-of-class-p class (eieio--object-class-object obj))))) (+ (eval-when-compile eieio--object-num-slots) fsi)) ((and (eq (cdr fsym) 'private) (or (and (eieio--scoped-class) @@ -1450,8 +1483,8 @@ reverse-lookup that name, and recurse with the associated slot value." eieio-initializing-object)) (+ (eval-when-compile eieio--object-num-slots) fsi)) (t nil)) - (let ((fn (eieio-initarg-to-attribute class slot))) - (if fn (eieio-slot-name-index class obj fn) nil))))) + (let ((fn (eieio--initarg-to-attribute class slot))) + (if fn (eieio--slot-name-index class obj fn) nil))))) (defun eieio-class-slot-name-index (class slot) "In CLASS find the index of the named SLOT. @@ -1477,20 +1510,20 @@ reverse-lookup that name, and recurse with the associated slot value." If SET-ALL is non-nil, then when a default is nil, that value is reset. If SET-ALL is nil, the slots are only reset if the default is not nil." - (eieio--with-scoped-class (eieio--object-class obj) + (eieio--with-scoped-class (eieio--object-class-object obj) (let ((eieio-initializing-object t) - (pub (eieio--class-public-a (eieio--class-v (eieio--object-class obj))))) + (pub (eieio--class-public-a (eieio--object-class-object obj)))) (while pub (let ((df (eieio-oref-default obj (car pub)))) (if (or df set-all) (eieio-oset obj (car pub) df))) (setq pub (cdr pub)))))) -(defun eieio-initarg-to-attribute (class initarg) +(defun eieio--initarg-to-attribute (class initarg) "For CLASS, convert INITARG to the actual attribute name. If there is no translation, pass it in directly (so we can cheat if need be... May remove that later...)" - (let ((tuple (assoc initarg (eieio--class-initarg-tuples (eieio--class-v class))))) + (let ((tuple (assoc initarg (eieio--class-initarg-tuples class)))) (if tuple (cdr tuple) nil))) @@ -1660,7 +1693,7 @@ This should only be called from a generic function." (load (nth 1 (symbol-function firstarg)))) ;; Determine the class to use. (cond ((eieio-object-p firstarg) - (setq mclass (eieio--object-class firstarg))) + (setq mclass (eieio--object-class-name firstarg))) ((class-p firstarg) (setq mclass firstarg)) ) @@ -1743,7 +1776,7 @@ This should only be called from a generic function." (let ((rval nil) (lastval nil) (found nil)) (while lambdas (if (car lambdas) - (eieio--with-scoped-class (cdr (car lambdas)) + (eieio--with-scoped-class (eieio--class-v (cdr (car lambdas))) (let* ((eieio-generic-call-key (car keys)) (has-return-val (or (= eieio-generic-call-key eieio--method-primary) @@ -1792,7 +1825,7 @@ for this common case to improve performance." ;; Determine the class to use. (cond ((eieio-object-p firstarg) - (setq mclass (eieio--object-class firstarg))) + (setq mclass (eieio--object-class-name firstarg))) ((not firstarg) (error "Method %s called on nil" method)) (t @@ -1811,7 +1844,7 @@ for this common case to improve performance." ;; Now loop through all occurrences forms which we must execute ;; (which are happily sorted now) and execute them all! - (eieio--with-scoped-class (cdr lambdas) + (eieio--with-scoped-class (eieio--class-v (cdr lambdas)) (let* ((rval nil) (lastval nil) (eieio-generic-call-key eieio--method-primary) ;; Use the cdr, as the first element is the fcn diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 8172cbeef6f..15a11ddb20f 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -193,7 +193,7 @@ Optional argument IGNORE is an extraneous parameter." (let* ((chil nil) (obj (widget-get widget :value)) (master-group (widget-get widget :eieio-group)) - (cv (eieio--class-v (eieio--object-class obj))) + (cv (eieio--object-class-object obj)) (slots (eieio--class-public-a cv)) (flabel (eieio--class-public-custom-label cv)) (fgroup (eieio--class-public-custom-group cv)) @@ -208,7 +208,8 @@ Optional argument IGNORE is an extraneous parameter." chil))) ;; Display information about the group being shown (when master-group - (let ((groups (class-option (eieio--object-class obj) :custom-groups))) + (let ((groups (class-option (eieio--object-class-name obj) + :custom-groups))) (widget-insert "Groups:") (while groups (widget-insert " ") @@ -261,7 +262,7 @@ Optional argument IGNORE is an extraneous parameter." (let ((s (symbol-name (or (class-slot-initarg - (eieio--object-class obj) + (eieio--object-class-name obj) (car slots)) (car slots))))) (capitalize @@ -288,7 +289,7 @@ Optional argument IGNORE is an extraneous parameter." "Get the value of WIDGET." (let* ((obj (widget-get widget :value)) (master-group eieio-cog) - (cv (eieio--class-v (eieio--object-class obj))) + (cv (eieio--object-class-object obj)) (fgroup (eieio--class-public-custom-group cv)) (wids (widget-get widget :children)) (name (if (widget-get widget :eieio-show-name) @@ -296,7 +297,7 @@ Optional argument IGNORE is an extraneous parameter." nil)) (chil (if (widget-get widget :eieio-show-name) (nthcdr 1 wids) wids)) - (cv (eieio--class-v (eieio--object-class obj))) + (cv (eieio--object-class-object obj)) (slots (eieio--class-public-a cv)) (fcust (eieio--class-public-custom cv))) ;; If there are any prefix widgets, clear them. @@ -451,7 +452,7 @@ Must return the created widget." (vector (concat "Group " (symbol-name group)) (list 'customize-object obj (list 'quote group)) t)) - (class-option (eieio--object-class obj) :custom-groups))) + (class-option (eieio--object-class-name obj) :custom-groups))) (defvar eieio-read-custom-group-history nil "History for the custom group reader.") @@ -459,7 +460,7 @@ Must return the created widget." (defmethod eieio-read-customization-group ((obj eieio-default-superclass)) "Do a completing read on the name of a customization group in OBJ. Return the symbol for the group, or nil" - (let ((g (class-option (eieio--object-class obj) :custom-groups))) + (let ((g (class-option (eieio--object-class-name obj) :custom-groups))) (if (= (length g) 1) (car g) ;; Make the association list diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 51b8c3d2b4a..e80791f9f75 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -267,13 +267,13 @@ variable name of the same name as the slot." ;; well embedded into an object. ;; (define-obsolete-function-alias - 'object-class-fast #'eieio--object-class "24.4") + 'object-class-fast #'eieio--object-class-name "24.4") (defun eieio-object-name (obj &optional extra) "Return a Lisp like symbol string for object OBJ. If EXTRA, include that in the string returned to represent the symbol." (eieio--check-type eieio-object-p obj) - (format "#<%s %s%s>" (symbol-name (eieio--object-class obj)) + (format "#<%s %s%s>" (eieio--object-class-name obj) (eieio-object-name-string obj) (or extra ""))) (define-obsolete-function-alias 'object-name #'eieio-object-name "24.4") @@ -299,9 +299,11 @@ If EXTRA, include that in the string returned to represent the symbol." (define-obsolete-function-alias 'object-set-name-string 'eieio-object-set-name-string "24.4") -(defun eieio-object-class (obj) "Return the class struct defining OBJ." +(defun eieio-object-class (obj) + "Return the class struct defining OBJ." + ;; FIXME: We say we return a "struct" but we return a symbol instead! (eieio--check-type eieio-object-p obj) - (eieio--object-class obj)) + (eieio--object-class-name obj)) (define-obsolete-function-alias 'object-class #'eieio-object-class "24.4") ;; CLOS name, maybe? (define-obsolete-function-alias 'class-of #'eieio-object-class "24.4") @@ -309,7 +311,7 @@ If EXTRA, include that in the string returned to represent the symbol." (defun eieio-object-class-name (obj) "Return a Lisp like symbol name for OBJ's class." (eieio--check-type eieio-object-p obj) - (eieio-class-name (eieio--object-class obj))) + (eieio-class-name (eieio--object-class-name obj))) (define-obsolete-function-alias 'object-class-name 'eieio-object-class-name "24.4") @@ -349,28 +351,31 @@ The CLOS function `class-direct-subclasses' is aliased to this function." "Return non-nil if OBJ is an instance of CLASS or CLASS' subclasses." (eieio--check-type eieio-object-p obj) ;; class will be checked one layer down - (child-of-class-p (eieio--object-class obj) class)) + (child-of-class-p (eieio--object-class-object obj) class)) ;; Backwards compatibility (defalias 'obj-of-class-p 'object-of-class-p) (defun child-of-class-p (child class) "Return non-nil if CHILD class is a subclass of CLASS." - (eieio--check-type class-p class) - (eieio--check-type class-p child) + (setq child (eieio--class-object child)) + (eieio--check-type eieio--class-p child) ;; `eieio-default-superclass' is never mentioned in eieio--class-parent, ;; so we have to special case it here. (or (eq class 'eieio-default-superclass) (let ((p nil)) + (setq class (eieio--class-object class)) + (eieio--check-type eieio--class-p class) (while (and child (not (eq child class))) - (setq p (append p (eieio--class-parent (eieio--class-v child))) - child (car p) - p (cdr p))) + ;; FIXME: eieio--class-parent should return class-objects rather than + ;; class-names! + (setq p (append p (eieio--class-parent child)) + child (eieio--class-v (pop p)))) (if child t)))) (defun object-slots (obj) "Return list of slots available in OBJ." (eieio--check-type eieio-object-p obj) - (eieio--class-public-a (eieio--class-v (eieio--object-class obj)))) + (eieio--class-public-a (eieio--object-class-object obj))) (defun class-slot-initarg (class slot) "Fetch from CLASS, SLOT's :initarg." (eieio--check-type class-p class) @@ -543,14 +548,14 @@ Use `next-method-p' to find out if there is a next method to call." (let ((newargs (or replacement-args eieio-generic-call-arglst)) (next (car eieio-generic-call-next-method-list)) ) - (if (or (not next) (not (car next))) + (if (not (and next (car next))) (apply #'no-next-method (car newargs) (cdr newargs)) (let* ((eieio-generic-call-next-method-list (cdr eieio-generic-call-next-method-list)) (eieio-generic-call-arglst newargs) (fcn (car next)) ) - (eieio--with-scoped-class (cdr next) + (eieio--with-scoped-class (eieio--class-v (cdr next)) (apply fcn newargs)) )))) ;;; Here are some CLOS items that need the CL package @@ -603,10 +608,10 @@ Called from the constructor routine.") (defmethod shared-initialize ((obj eieio-default-superclass) slots) "Set slots of OBJ with SLOTS which is a list of name/value pairs. Called from the constructor routine." - (eieio--with-scoped-class (eieio--object-class obj) + (eieio--with-scoped-class (eieio--object-class-object obj) (while slots - (let ((rn (eieio-initarg-to-attribute (eieio--object-class obj) - (car slots)))) + (let ((rn (eieio--initarg-to-attribute (eieio--object-class-object obj) + (car slots)))) (if (not rn) (slot-missing obj (car slots) 'oset (car (cdr slots))) (eieio-oset obj rn (car (cdr slots))))) @@ -627,7 +632,7 @@ not taken, then new objects of your class will not have their values dynamically set from SLOTS." ;; First, see if any of our defaults are `lambda', and ;; re-evaluate them and apply the value to our slots. - (let* ((this-class (eieio--class-v (eieio--object-class this))) + (let* ((this-class (eieio--object-class-object this)) (slot (eieio--class-public-a this-class)) (defaults (eieio--class-public-d this-class))) (while slot @@ -883,7 +888,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to ;;; Start of automatically extracted autoloads. -;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "3a6fffe3af331fe960f967d0da99e8e9") +;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "2b4c57cf907e879e8bbc88d8f0e2de4c") ;;; Generated autoloads from eieio-custom.el (autoload 'customize-object "eieio-custom" "\ diff --git a/test/ChangeLog b/test/ChangeLog index bcc619a7f97..53e2c49c9d7 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,16 @@ +2014-12-29 Stefan Monnier + + * automated/eieio-test-methodinvoke.el (eieio-test-method-store): + Adjust to new semantics of eieio--scoped-class. + (eieio-test-match): Improve error feedback. + +2014-12-23 Stefan Monnier + + * automated/eieio-tests.el: Remove dummy object names. + + * automated/eieio-test-persist.el (persistent-with-objs-slot-subs): + The type FOO-child is the same as FOO. + 2014-12-22 Stefan Monnier * automated/eieio-test-methodinvoke.el (eieio-test-method-store): diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el index 3f86d8fcc99..f99ee8d1f46 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/automated/eieio-test-methodinvoke.el @@ -61,14 +61,16 @@ "Store current invocation class symbol in the invocation order list." (let* ((keysym (aref [ :STATIC :BEFORE :PRIMARY :AFTER ] (or eieio-generic-call-key 0))) - (c (list keysym (eieio--scoped-class)))) + ;; FIXME: Don't depend on `eieio--scoped-class'! + (c (list keysym (eieio--class-symbol (eieio--scoped-class))))) (push c eieio-test-method-order-list))) (defun eieio-test-match (rightanswer) "Do a test match." (if (equal rightanswer eieio-test-method-order-list) t - (error "eieio-test-methodinvoke.el: Test Failed!"))) + (error "eieio-test-methodinvoke.el: Test Failed: %S != %S" + rightanswer eieio-test-method-order-list))) (defvar eieio-test-call-next-method-arguments nil "List of passed to methods during execution of `call-next-method'.") -- 2.39.2