mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-24 06:20:43 -08:00
* lisp/emacs-lisp/eieio*.el: Remove "name" field of objects
* lisp/emacs-lisp/eieio-base.el (clone) <eieio-instance-inheritor>: Use call-next-method. (eieio-constructor): Rename from `constructor'. (eieio-persistent-convert-list-to-object): Drop objname. (eieio-persistent-validate/fix-slot-value): Don't hardcode eieio--object-num-slots. (eieio-named): Use a normal slot. (slot-missing) <eieio-named>: Remove. (eieio-object-name-string, eieio-object-set-name-string, clone) <eieio-named>: New methods. * lisp/emacs-lisp/eieio-core.el (eieio--defalias): Follow aliases. (eieio--object): Remove `name' field. (eieio-defclass): Adjust to new convention where constructors don't take an "object name" any more. (eieio--defgeneric-init-form, eieio--defmethod): Follow aliases. (eieio-validate-slot-value, eieio-oset-default) (eieio-slot-name-index): Don't hardcode eieio--object-num-slots. (eieio-generic-call-primary-only): Simplify. * lisp/emacs-lisp/eieio-custom.el (eieio-widget-test): Remove dummy arg. (eieio-object-value-get): Use eieio-object-set-name-string. * lisp/emacs-lisp/eieio.el (make-instance): Simplify by not adding an object name argument. (eieio-object-name): Use eieio-object-name-string. (eieio--object-names): New const. (eieio-object-name-string, eieio-object-set-name-string): Re-implement using a hashtable rather than a built-in slot. (eieio-constructor): Rename from `constructor'. Remove `newname' arg. (clone): Don't mess with the object's "name". * test/automated/eieio-test-persist.el (persistent-with-objs-slot-subs): The type FOO-child is the same as FOO. * test/automated/eieio-tests.el: Remove dummy object names.
This commit is contained in:
parent
d4a12e7a9a
commit
ee93d7ad42
8 changed files with 167 additions and 135 deletions
|
|
@ -1,3 +1,37 @@
|
||||||
|
2014-12-23 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||||
|
|
||||||
|
* emacs-lisp/eieio.el (make-instance): Simplify by not adding an object
|
||||||
|
name argument.
|
||||||
|
(eieio-object-name): Use eieio-object-name-string.
|
||||||
|
(eieio--object-names): New const.
|
||||||
|
(eieio-object-name-string, eieio-object-set-name-string): Re-implement
|
||||||
|
using a hashtable rather than a built-in slot.
|
||||||
|
(eieio-constructor): Rename from `constructor'. Remove `newname' arg.
|
||||||
|
(clone): Don't mess with the object's "name".
|
||||||
|
|
||||||
|
* emacs-lisp/eieio-custom.el (eieio-widget-test): Remove dummy arg.
|
||||||
|
(eieio-object-value-get): Use eieio-object-set-name-string.
|
||||||
|
|
||||||
|
* emacs-lisp/eieio-core.el (eieio--defalias): Follow aliases.
|
||||||
|
(eieio--object): Remove `name' field.
|
||||||
|
(eieio-defclass): Adjust to new convention where constructors don't
|
||||||
|
take an "object name" any more.
|
||||||
|
(eieio--defgeneric-init-form, eieio--defmethod): Follow aliases.
|
||||||
|
(eieio-validate-slot-value, eieio-oset-default)
|
||||||
|
(eieio-slot-name-index): Don't hardcode eieio--object-num-slots.
|
||||||
|
(eieio-generic-call-primary-only): Simplify.
|
||||||
|
|
||||||
|
* emacs-lisp/eieio-base.el (clone) <eieio-instance-inheritor>:
|
||||||
|
Use call-next-method.
|
||||||
|
(eieio-constructor): Rename from `constructor'.
|
||||||
|
(eieio-persistent-convert-list-to-object): Drop objname.
|
||||||
|
(eieio-persistent-validate/fix-slot-value): Don't hardcode
|
||||||
|
eieio--object-num-slots.
|
||||||
|
(eieio-named): Use a normal slot.
|
||||||
|
(slot-missing) <eieio-named>: Remove.
|
||||||
|
(eieio-object-name-string, eieio-object-set-name-string, clone)
|
||||||
|
<eieio-named>: New methods.
|
||||||
|
|
||||||
2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
|
2014-12-22 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||||
|
|
||||||
* emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v.
|
* emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v.
|
||||||
|
|
|
||||||
|
|
@ -63,25 +63,10 @@ SLOT-NAME is the offending slot. FN is the function signaling the error."
|
||||||
;; Throw the regular signal.
|
;; Throw the regular signal.
|
||||||
(call-next-method)))
|
(call-next-method)))
|
||||||
|
|
||||||
(defmethod clone ((obj eieio-instance-inheritor) &rest params)
|
(defmethod clone ((obj eieio-instance-inheritor) &rest _params)
|
||||||
"Clone OBJ, initializing `:parent' to OBJ.
|
"Clone OBJ, initializing `:parent' to OBJ.
|
||||||
All slots are unbound, except those initialized with PARAMS."
|
All slots are unbound, except those initialized with PARAMS."
|
||||||
(let ((nobj (make-vector (length obj) eieio-unbound))
|
(let ((nobj (call-next-method)))
|
||||||
(nm (eieio--object-name obj))
|
|
||||||
(passname (and params (stringp (car params))))
|
|
||||||
(num 1))
|
|
||||||
(aset nobj 0 'object)
|
|
||||||
(setf (eieio--object-class nobj) (eieio--object-class obj))
|
|
||||||
;; The following was copied from the default clone.
|
|
||||||
(if (not passname)
|
|
||||||
(save-match-data
|
|
||||||
(if (string-match "-\\([0-9]+\\)" nm)
|
|
||||||
(setq num (1+ (string-to-number (match-string 1 nm)))
|
|
||||||
nm (substring nm 0 (match-beginning 0))))
|
|
||||||
(setf (eieio--object-name nobj) (concat nm "-" (int-to-string num))))
|
|
||||||
(setf (eieio--object-name nobj) (car params)))
|
|
||||||
;; Now initialize from params.
|
|
||||||
(if params (shared-initialize nobj (if passname (cdr params) params)))
|
|
||||||
(oset nobj parent-instance obj)
|
(oset nobj parent-instance obj)
|
||||||
nobj))
|
nobj))
|
||||||
|
|
||||||
|
|
@ -155,7 +140,7 @@ Multiple calls to `make-instance' will return this object."))
|
||||||
A singleton is a class which will only ever have one instance."
|
A singleton is a class which will only ever have one instance."
|
||||||
:abstract t)
|
:abstract t)
|
||||||
|
|
||||||
(defmethod constructor :STATIC ((class eieio-singleton) _name &rest _slots)
|
(defmethod eieio-constructor :STATIC ((class eieio-singleton) &rest _slots)
|
||||||
"Constructor for singleton CLASS.
|
"Constructor for singleton CLASS.
|
||||||
NAME and SLOTS initialize the new object.
|
NAME and SLOTS initialize the new object.
|
||||||
This constructor guarantees that no matter how many you request,
|
This constructor guarantees that no matter how many you request,
|
||||||
|
|
@ -270,7 +255,7 @@ malicious code.
|
||||||
Note: This function recurses when a slot of :type of some object is
|
Note: This function recurses when a slot of :type of some object is
|
||||||
identified, and needing more object creation."
|
identified, and needing more object creation."
|
||||||
(let ((objclass (nth 0 inputlist))
|
(let ((objclass (nth 0 inputlist))
|
||||||
(objname (nth 1 inputlist))
|
;; (objname (nth 1 inputlist))
|
||||||
(slots (nthcdr 2 inputlist))
|
(slots (nthcdr 2 inputlist))
|
||||||
(createslots nil))
|
(createslots nil))
|
||||||
|
|
||||||
|
|
@ -293,7 +278,7 @@ identified, and needing more object creation."
|
||||||
|
|
||||||
(setq slots (cdr (cdr slots))))
|
(setq slots (cdr (cdr slots))))
|
||||||
|
|
||||||
(apply 'make-instance objclass objname (nreverse createslots))
|
(apply #'make-instance objclass (nreverse createslots))
|
||||||
|
|
||||||
;;(eval inputlist)
|
;;(eval inputlist)
|
||||||
))
|
))
|
||||||
|
|
@ -308,7 +293,8 @@ Second, any text properties will be stripped from strings."
|
||||||
(let ((slot-idx (eieio-slot-name-index class nil slot))
|
(let ((slot-idx (eieio-slot-name-index class nil slot))
|
||||||
(type nil)
|
(type nil)
|
||||||
(classtype nil))
|
(classtype nil))
|
||||||
(setq slot-idx (- slot-idx 3))
|
(setq slot-idx (- slot-idx
|
||||||
|
(eval-when-compile eieio--object-num-slots)))
|
||||||
(setq type (aref (eieio--class-public-type (eieio--class-v class))
|
(setq type (aref (eieio--class-public-type (eieio--class-v class))
|
||||||
slot-idx))
|
slot-idx))
|
||||||
|
|
||||||
|
|
@ -463,34 +449,38 @@ instance."
|
||||||
|
|
||||||
|
|
||||||
;;; Named object
|
;;; Named object
|
||||||
;;
|
|
||||||
;; Named objects use the objects `name' as a slot, and that slot
|
|
||||||
;; is accessed with the `object-name' symbol.
|
|
||||||
|
|
||||||
(defclass eieio-named ()
|
(defclass eieio-named ()
|
||||||
()
|
((object-name :initarg :object-name :initform nil))
|
||||||
"Object with a name.
|
"Object with a name."
|
||||||
Name storage already occurs in an object. This object provides get/set
|
|
||||||
access to it."
|
|
||||||
:abstract t)
|
:abstract t)
|
||||||
|
|
||||||
(defmethod slot-missing ((obj eieio-named)
|
(defmethod eieio-object-name-string ((obj eieio-named))
|
||||||
slot-name operation &optional new-value)
|
"Return a string which is OBJ's name."
|
||||||
"Called when a non-existent slot is accessed.
|
(or (slot-value obj 'object-name)
|
||||||
For variable `eieio-named', provide an imaginary `object-name' slot.
|
(symbol-name (eieio-object-class obj))))
|
||||||
Argument OBJ is the named object.
|
|
||||||
Argument SLOT-NAME is the slot that was attempted to be accessed.
|
(defmethod eieio-object-set-name-string ((obj eieio-named) name)
|
||||||
OPERATION is the type of access, such as `oref' or `oset'.
|
"Set the string which is OBJ's NAME."
|
||||||
NEW-VALUE is the value that was being set into SLOT if OPERATION were
|
(eieio--check-type stringp name)
|
||||||
a set type."
|
(eieio-oset obj 'object-name name))
|
||||||
(if (memq slot-name '(object-name :object-name))
|
|
||||||
(cond ((eq operation 'oset)
|
(defmethod clone ((obj eieio-named) &rest params)
|
||||||
(if (not (stringp new-value))
|
"Clone OBJ, initializing `:parent' to OBJ.
|
||||||
(signal 'invalid-slot-type
|
All slots are unbound, except those initialized with PARAMS."
|
||||||
(list obj slot-name 'string new-value)))
|
(let* ((newname (and (stringp (car params)) (pop params)))
|
||||||
(eieio-object-set-name-string obj new-value))
|
(nobj (apply #'call-next-method obj params))
|
||||||
(t (eieio-object-name-string obj)))
|
(nm (slot-value obj 'object-name)))
|
||||||
(call-next-method)))
|
(eieio-oset obj 'object-name
|
||||||
|
(or newname
|
||||||
|
(save-match-data
|
||||||
|
(if (and nm (string-match "-\\([0-9]+\\)" nm))
|
||||||
|
(let ((num (1+ (string-to-number
|
||||||
|
(match-string 1 nm)))))
|
||||||
|
(concat (substring nm 0 (match-beginning 0))
|
||||||
|
"-" (int-to-string num)))
|
||||||
|
(concat nm "-1")))))
|
||||||
|
nobj))
|
||||||
|
|
||||||
(provide 'eieio-base)
|
(provide 'eieio-base)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -39,6 +39,9 @@
|
||||||
"Like `defalias', but with less side-effects.
|
"Like `defalias', but with less side-effects.
|
||||||
More specifically, it has no side-effects at all when the new function
|
More specifically, it has no side-effects at all when the new function
|
||||||
definition is the same (`eq') as the old one."
|
definition is the same (`eq') as the old one."
|
||||||
|
(while (and (fboundp name) (symbolp (symbol-function name)))
|
||||||
|
;; Follow aliases, so methods applied to obsolete aliases still work.
|
||||||
|
(setq name (symbol-function name)))
|
||||||
(unless (and (fboundp name)
|
(unless (and (fboundp name)
|
||||||
(eq (symbol-function name) body))
|
(eq (symbol-function name) body))
|
||||||
(defalias name body)))
|
(defalias name body)))
|
||||||
|
|
@ -167,8 +170,7 @@ Stored outright without modifications or stripping.")))
|
||||||
|
|
||||||
(eieio--define-field-accessors object
|
(eieio--define-field-accessors object
|
||||||
(-unused-0 ;;Constant slot, set to `object'.
|
(-unused-0 ;;Constant slot, set to `object'.
|
||||||
(class "class struct defining OBJ")
|
(class "class struct defining OBJ")))
|
||||||
name)) ;FIXME: Get rid of this field!
|
|
||||||
|
|
||||||
;; FIXME: The constants below should have an `eieio-' prefix added!!
|
;; FIXME: The constants below should have an `eieio-' prefix added!!
|
||||||
(defconst eieio--method-static 0 "Index into :static tag on a method.")
|
(defconst eieio--method-static 0 "Index into :static tag on a method.")
|
||||||
|
|
@ -480,10 +482,10 @@ See `defclass' for more information."
|
||||||
;; Create the test function
|
;; Create the test function
|
||||||
(let ((csym (intern (concat (symbol-name cname) "-p"))))
|
(let ((csym (intern (concat (symbol-name cname) "-p"))))
|
||||||
(fset csym
|
(fset csym
|
||||||
(list 'lambda (list 'obj)
|
`(lambda (obj)
|
||||||
(format "Test OBJ to see if it an object of type %s" cname)
|
,(format "Test OBJ to see if it an object of type %s" cname)
|
||||||
(list 'and '(eieio-object-p obj)
|
(and (eieio-object-p obj)
|
||||||
(list 'same-class-p 'obj cname)))))
|
(same-class-p obj ',cname)))))
|
||||||
|
|
||||||
;; Make sure the method invocation order is a valid value.
|
;; Make sure the method invocation order is a valid value.
|
||||||
(let ((io (class-option-assoc options :method-invocation-order)))
|
(let ((io (class-option-assoc options :method-invocation-order)))
|
||||||
|
|
@ -499,7 +501,7 @@ See `defclass' for more information."
|
||||||
"Test OBJ to see if it an object is a child of type %s"
|
"Test OBJ to see if it an object is a child of type %s"
|
||||||
cname)
|
cname)
|
||||||
(and (eieio-object-p obj)
|
(and (eieio-object-p obj)
|
||||||
(object-of-class-p obj ,cname))))
|
(object-of-class-p obj ',cname))))
|
||||||
|
|
||||||
;; When using typep, (typep OBJ 'myclass) returns t for objects which
|
;; When using typep, (typep OBJ 'myclass) returns t for objects which
|
||||||
;; are subclasses of myclass. For our predicates, however, it is
|
;; are subclasses of myclass. For our predicates, however, it is
|
||||||
|
|
@ -722,9 +724,14 @@ See `defclass' for more information."
|
||||||
|
|
||||||
;; Non-abstract classes need a constructor.
|
;; Non-abstract classes need a constructor.
|
||||||
(fset cname
|
(fset cname
|
||||||
`(lambda (newname &rest slots)
|
`(lambda (&rest slots)
|
||||||
,(format "Create a new object with name NAME of class type %s" cname)
|
,(format "Create a new object with name NAME of class type %s" cname)
|
||||||
(apply #'constructor ,cname newname slots)))
|
(if (and slots
|
||||||
|
(let ((x (car slots)))
|
||||||
|
(or (stringp x) (null x))))
|
||||||
|
(message "Obsolete name %S passed to %S constructor"
|
||||||
|
(pop slots) ',cname))
|
||||||
|
(apply #'eieio-constructor ',cname slots)))
|
||||||
)
|
)
|
||||||
|
|
||||||
;; Set up a specialized doc string.
|
;; Set up a specialized doc string.
|
||||||
|
|
@ -761,7 +768,6 @@ See `defclass' for more information."
|
||||||
nil)))
|
nil)))
|
||||||
(aset cache 0 'object)
|
(aset cache 0 'object)
|
||||||
(setf (eieio--object-class cache) cname)
|
(setf (eieio--object-class cache) cname)
|
||||||
(setf (eieio--object-name cache) 'default-cache-object)
|
|
||||||
(let ((eieio-skip-typecheck t))
|
(let ((eieio-skip-typecheck t))
|
||||||
;; All type-checking has been done to our satisfaction
|
;; All type-checking has been done to our satisfaction
|
||||||
;; before this call. Don't waste our time in this call..
|
;; before this call. Don't waste our time in this call..
|
||||||
|
|
@ -1087,6 +1093,10 @@ the new child class."
|
||||||
|
|
||||||
(defun eieio--defgeneric-init-form (method doc-string)
|
(defun eieio--defgeneric-init-form (method doc-string)
|
||||||
"Form to use for the initial definition of a generic."
|
"Form to use for the initial definition of a generic."
|
||||||
|
(while (and (fboundp method) (symbolp (symbol-function method)))
|
||||||
|
;; Follow aliases, so methods applied to obsolete aliases still work.
|
||||||
|
(setq method (symbol-function method)))
|
||||||
|
|
||||||
(cond
|
(cond
|
||||||
((or (not (fboundp method))
|
((or (not (fboundp method))
|
||||||
(eq 'autoload (car-safe (symbol-function method))))
|
(eq 'autoload (car-safe (symbol-function method))))
|
||||||
|
|
@ -1198,6 +1208,11 @@ but remove reference to all implementations of METHOD."
|
||||||
;; Primary key.
|
;; Primary key.
|
||||||
;; (t eieio--method-primary)
|
;; (t eieio--method-primary)
|
||||||
(t (error "Unknown method kind %S" kind)))))
|
(t (error "Unknown method kind %S" kind)))))
|
||||||
|
|
||||||
|
(while (and (fboundp method) (symbolp (symbol-function method)))
|
||||||
|
;; Follow aliases, so methods applied to obsolete aliases still work.
|
||||||
|
(setq method (symbol-function method)))
|
||||||
|
|
||||||
;; Make sure there is a generic (when called from defclass).
|
;; Make sure there is a generic (when called from defclass).
|
||||||
(eieio--defalias
|
(eieio--defalias
|
||||||
method (eieio--defgeneric-init-form
|
method (eieio--defgeneric-init-form
|
||||||
|
|
@ -1253,7 +1268,7 @@ an error."
|
||||||
(if eieio-skip-typecheck
|
(if eieio-skip-typecheck
|
||||||
nil
|
nil
|
||||||
;; Trim off object IDX junk added in for the object index.
|
;; Trim off object IDX junk added in for the object index.
|
||||||
(setq slot-idx (- slot-idx 3))
|
(setq slot-idx (- slot-idx (eval-when-compile eieio--object-num-slots)))
|
||||||
(let ((st (aref (eieio--class-public-type (eieio--class-v class)) slot-idx)))
|
(let ((st (aref (eieio--class-public-type (eieio--class-v class)) slot-idx)))
|
||||||
(if (not (eieio-perform-slot-validation st value))
|
(if (not (eieio-perform-slot-validation st value))
|
||||||
(signal 'invalid-slot-type (list class slot st value))))))
|
(signal 'invalid-slot-type (list class slot st value))))))
|
||||||
|
|
@ -1324,7 +1339,8 @@ Fills in OBJ's SLOT with its default value."
|
||||||
;;(signal 'invalid-slot-name (list (class-name cl) slot))
|
;;(signal 'invalid-slot-name (list (class-name cl) slot))
|
||||||
)
|
)
|
||||||
(eieio-barf-if-slot-unbound
|
(eieio-barf-if-slot-unbound
|
||||||
(let ((val (nth (- c 3) (eieio--class-public-d (eieio--class-v cl)))))
|
(let ((val (nth (- c (eval-when-compile eieio--object-num-slots))
|
||||||
|
(eieio--class-public-d (eieio--class-v cl)))))
|
||||||
(eieio-default-eval-maybe val))
|
(eieio-default-eval-maybe val))
|
||||||
obj cl 'oref-default))))
|
obj cl 'oref-default))))
|
||||||
|
|
||||||
|
|
@ -1382,7 +1398,8 @@ Fills in the default value in CLASS' in SLOT with VALUE."
|
||||||
(signal 'invalid-slot-name (list (eieio-class-name class) slot)))
|
(signal 'invalid-slot-name (list (eieio-class-name class) slot)))
|
||||||
(eieio-validate-slot-value class c value slot)
|
(eieio-validate-slot-value class c value slot)
|
||||||
;; Set this into the storage for defaults.
|
;; Set this into the storage for defaults.
|
||||||
(setcar (nthcdr (- c 3) (eieio--class-public-d (eieio--class-v class)))
|
(setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
|
||||||
|
(eieio--class-public-d (eieio--class-v class)))
|
||||||
value)
|
value)
|
||||||
;; Take the value, and put it into our cache object.
|
;; Take the value, and put it into our cache object.
|
||||||
(eieio-oset (eieio--class-default-object-cache (eieio--class-v class))
|
(eieio-oset (eieio--class-default-object-cache (eieio--class-v class))
|
||||||
|
|
@ -1420,18 +1437,18 @@ reverse-lookup that name, and recurse with the associated slot value."
|
||||||
(if (integerp fsi)
|
(if (integerp fsi)
|
||||||
(cond
|
(cond
|
||||||
((not (cdr fsym))
|
((not (cdr fsym))
|
||||||
(+ 3 fsi))
|
(+ (eval-when-compile eieio--object-num-slots) fsi))
|
||||||
((and (eq (cdr fsym) 'protected)
|
((and (eq (cdr fsym) 'protected)
|
||||||
(eieio--scoped-class)
|
(eieio--scoped-class)
|
||||||
(or (child-of-class-p class (eieio--scoped-class))
|
(or (child-of-class-p class (eieio--scoped-class))
|
||||||
(and (eieio-object-p obj)
|
(and (eieio-object-p obj)
|
||||||
(child-of-class-p class (eieio--object-class obj)))))
|
(child-of-class-p class (eieio--object-class obj)))))
|
||||||
(+ 3 fsi))
|
(+ (eval-when-compile eieio--object-num-slots) fsi))
|
||||||
((and (eq (cdr fsym) 'private)
|
((and (eq (cdr fsym) 'private)
|
||||||
(or (and (eieio--scoped-class)
|
(or (and (eieio--scoped-class)
|
||||||
(eieio-slot-originating-class-p (eieio--scoped-class) slot))
|
(eieio-slot-originating-class-p (eieio--scoped-class) slot))
|
||||||
eieio-initializing-object))
|
eieio-initializing-object))
|
||||||
(+ 3 fsi))
|
(+ (eval-when-compile eieio--object-num-slots) fsi))
|
||||||
(t nil))
|
(t nil))
|
||||||
(let ((fn (eieio-initarg-to-attribute class slot)))
|
(let ((fn (eieio-initarg-to-attribute class slot)))
|
||||||
(if fn (eieio-slot-name-index class obj fn) nil)))))
|
(if fn (eieio-slot-name-index class obj fn) nil)))))
|
||||||
|
|
@ -1778,12 +1795,8 @@ for this common case to improve performance."
|
||||||
(setq mclass (eieio--object-class firstarg)))
|
(setq mclass (eieio--object-class firstarg)))
|
||||||
((not firstarg)
|
((not firstarg)
|
||||||
(error "Method %s called on nil" method))
|
(error "Method %s called on nil" method))
|
||||||
((not (eieio-object-p firstarg))
|
|
||||||
(error "Primary-only method %s called on something not an object" method))
|
|
||||||
(t
|
(t
|
||||||
(error "EIEIO Error: Improperly classified method %s as primary only"
|
(error "Primary-only method %s called on something not an object" method)))
|
||||||
method)
|
|
||||||
))
|
|
||||||
;; Make sure the class is a valid class
|
;; Make sure the class is a valid class
|
||||||
;; mclass can be nil (meaning a generic for should be used.
|
;; mclass can be nil (meaning a generic for should be used.
|
||||||
;; mclass cannot have a value that is not a class, however.
|
;; mclass cannot have a value that is not a class, however.
|
||||||
|
|
|
||||||
|
|
@ -70,7 +70,7 @@ of these.")
|
||||||
:documentation "A number of thingies."))
|
:documentation "A number of thingies."))
|
||||||
"A class for testing the widget on.")
|
"A class for testing the widget on.")
|
||||||
|
|
||||||
(defcustom eieio-widget-test (eieio-widget-test-class "Foo")
|
(defcustom eieio-widget-test (eieio-widget-test-class)
|
||||||
"Test variable for editing an object."
|
"Test variable for editing an object."
|
||||||
:type 'object
|
:type 'object
|
||||||
:group 'eieio)
|
:group 'eieio)
|
||||||
|
|
@ -317,7 +317,7 @@ Optional argument IGNORE is an extraneous parameter."
|
||||||
fgroup (cdr fgroup)
|
fgroup (cdr fgroup)
|
||||||
fcust (cdr fcust)))
|
fcust (cdr fcust)))
|
||||||
;; Set any name updates on it.
|
;; Set any name updates on it.
|
||||||
(if name (setf (eieio--object-name obj) name))
|
(if name (eieio-object-set-name-string obj name))
|
||||||
;; This is the same object we had before.
|
;; This is the same object we had before.
|
||||||
obj))
|
obj))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -144,12 +144,7 @@ In EIEIO, the class' constructor requires a name for use when printing.
|
||||||
`make-instance' in CLOS doesn't use names the way Emacs does, so the
|
`make-instance' in CLOS doesn't use names the way Emacs does, so the
|
||||||
class is used as the name slot instead when INITARGS doesn't start with
|
class is used as the name slot instead when INITARGS doesn't start with
|
||||||
a string."
|
a string."
|
||||||
(if (and (car initargs) (stringp (car initargs)))
|
(apply (class-constructor class) initargs))
|
||||||
(apply (class-constructor class) initargs)
|
|
||||||
(apply (class-constructor class)
|
|
||||||
(cond ((symbolp class) (symbol-name class))
|
|
||||||
(t (format "%S" class)))
|
|
||||||
initargs)))
|
|
||||||
|
|
||||||
|
|
||||||
;;; CLOS methods and generics
|
;;; CLOS methods and generics
|
||||||
|
|
@ -279,20 +274,28 @@ variable name of the same name as the slot."
|
||||||
If EXTRA, include that in the string returned to represent the symbol."
|
If EXTRA, include that in the string returned to represent the symbol."
|
||||||
(eieio--check-type eieio-object-p obj)
|
(eieio--check-type eieio-object-p obj)
|
||||||
(format "#<%s %s%s>" (symbol-name (eieio--object-class obj))
|
(format "#<%s %s%s>" (symbol-name (eieio--object-class obj))
|
||||||
(eieio--object-name obj) (or extra "")))
|
(eieio-object-name-string obj) (or extra "")))
|
||||||
(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
|
(define-obsolete-function-alias 'object-name #'eieio-object-name "24.4")
|
||||||
|
|
||||||
(defun eieio-object-name-string (obj) "Return a string which is OBJ's name."
|
(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key))
|
||||||
(eieio--check-type eieio-object-p obj)
|
|
||||||
(eieio--object-name obj))
|
;; In the past, every EIEIO object had a `name' field, so we had the two method
|
||||||
|
;; below "for free". Since this field is very rarely used, we got rid of it
|
||||||
|
;; and instead we keep it in a weak hash-tables, for those very rare objects
|
||||||
|
;; that use it.
|
||||||
|
(defmethod eieio-object-name-string (obj)
|
||||||
|
"Return a string which is OBJ's name."
|
||||||
|
(declare (obsolete eieio-named "25.1"))
|
||||||
|
(or (gethash obj eieio--object-names)
|
||||||
|
(symbol-name (eieio-object-class obj))))
|
||||||
(define-obsolete-function-alias
|
(define-obsolete-function-alias
|
||||||
'object-name-string #'eieio-object-name-string "24.4")
|
'object-name-string #'eieio-object-name-string "24.4")
|
||||||
|
|
||||||
(defun eieio-object-set-name-string (obj name)
|
(defmethod eieio-object-set-name-string (obj name)
|
||||||
"Set the string which is OBJ's NAME."
|
"Set the string which is OBJ's NAME."
|
||||||
(eieio--check-type eieio-object-p obj)
|
(declare (obsolete eieio-named "25.1"))
|
||||||
(eieio--check-type stringp name)
|
(eieio--check-type stringp name)
|
||||||
(setf (eieio--object-name obj) name))
|
(setf (gethash obj eieio--object-names) name))
|
||||||
(define-obsolete-function-alias
|
(define-obsolete-function-alias
|
||||||
'object-set-name-string 'eieio-object-set-name-string "24.4")
|
'object-set-name-string 'eieio-object-set-name-string "24.4")
|
||||||
|
|
||||||
|
|
@ -574,20 +577,19 @@ This class is not stored in the `parent' slot of a class vector."
|
||||||
|
|
||||||
(defalias 'standard-class 'eieio-default-superclass)
|
(defalias 'standard-class 'eieio-default-superclass)
|
||||||
|
|
||||||
(defgeneric constructor (class newname &rest slots)
|
(defgeneric eieio-constructor (class &rest slots)
|
||||||
"Default constructor for CLASS `eieio-default-superclass'.")
|
"Default constructor for CLASS `eieio-default-superclass'.")
|
||||||
|
|
||||||
(defmethod constructor :static
|
(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1")
|
||||||
((class eieio-default-superclass) newname &rest slots)
|
|
||||||
|
(defmethod eieio-constructor :static
|
||||||
|
((class eieio-default-superclass) &rest slots)
|
||||||
"Default constructor for CLASS `eieio-default-superclass'.
|
"Default constructor for CLASS `eieio-default-superclass'.
|
||||||
NEWNAME is the name to be given to the constructed object.
|
|
||||||
SLOTS are the initialization slots used by `shared-initialize'.
|
SLOTS are the initialization slots used by `shared-initialize'.
|
||||||
This static method is called when an object is constructed.
|
This static method is called when an object is constructed.
|
||||||
It allocates the vector used to represent an EIEIO object, and then
|
It allocates the vector used to represent an EIEIO object, and then
|
||||||
calls `shared-initialize' on that object."
|
calls `shared-initialize' on that object."
|
||||||
(let* ((new-object (copy-sequence (eieio--class-default-object-cache (eieio--class-v class)))))
|
(let* ((new-object (copy-sequence (eieio--class-default-object-cache (eieio--class-v class)))))
|
||||||
;; Update the name for the newly created object.
|
|
||||||
(setf (eieio--object-name new-object) newname)
|
|
||||||
;; Call the initialize method on the new object with the slots
|
;; Call the initialize method on the new object with the slots
|
||||||
;; that were passed down to us.
|
;; that were passed down to us.
|
||||||
(initialize-instance new-object slots)
|
(initialize-instance new-object slots)
|
||||||
|
|
@ -715,18 +717,10 @@ first and modify the returned object.")
|
||||||
|
|
||||||
(defmethod clone ((obj eieio-default-superclass) &rest params)
|
(defmethod clone ((obj eieio-default-superclass) &rest params)
|
||||||
"Make a copy of OBJ, and then apply PARAMS."
|
"Make a copy of OBJ, and then apply PARAMS."
|
||||||
(let ((nobj (copy-sequence obj))
|
(let ((nobj (copy-sequence obj)))
|
||||||
(nm (eieio--object-name obj))
|
(if (stringp (car params))
|
||||||
(passname (and params (stringp (car params))))
|
(message "Obsolete name %S passed to clone" (pop params)))
|
||||||
(num 1))
|
(if params (shared-initialize nobj params))
|
||||||
(if params (shared-initialize nobj (if passname (cdr params) params)))
|
|
||||||
(if (not passname)
|
|
||||||
(save-match-data
|
|
||||||
(if (string-match "-\\([0-9]+\\)" nm)
|
|
||||||
(setq num (1+ (string-to-number (match-string 1 nm)))
|
|
||||||
nm (substring nm 0 (match-beginning 0))))
|
|
||||||
(setf (eieio--object-name nobj) (concat nm "-" (int-to-string num))))
|
|
||||||
(setf (eieio--object-name nobj) (car params)))
|
|
||||||
nobj))
|
nobj))
|
||||||
|
|
||||||
(defgeneric destructor (this &rest params)
|
(defgeneric destructor (this &rest params)
|
||||||
|
|
@ -889,7 +883,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to
|
||||||
|
|
||||||
;;; Start of automatically extracted autoloads.
|
;;; Start of automatically extracted autoloads.
|
||||||
|
|
||||||
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "6413249ec10091eb7094238637b40e2c")
|
;;;### (autoloads nil "eieio-custom" "eieio-custom.el" "3a6fffe3af331fe960f967d0da99e8e9")
|
||||||
;;; Generated autoloads from eieio-custom.el
|
;;; Generated autoloads from eieio-custom.el
|
||||||
|
|
||||||
(autoload 'customize-object "eieio-custom" "\
|
(autoload 'customize-object "eieio-custom" "\
|
||||||
|
|
@ -900,7 +894,7 @@ Optional argument GROUP is the sub-group of slots to display.
|
||||||
|
|
||||||
;;;***
|
;;;***
|
||||||
|
|
||||||
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "6f114a48de40212413d2776eedc3ec14")
|
;;;### (autoloads nil "eieio-opt" "eieio-opt.el" "2ff7d98da3f84c6af5c873ffb781930e")
|
||||||
;;; Generated autoloads from eieio-opt.el
|
;;; Generated autoloads from eieio-opt.el
|
||||||
|
|
||||||
(autoload 'eieio-browse "eieio-opt" "\
|
(autoload 'eieio-browse "eieio-opt" "\
|
||||||
|
|
|
||||||
|
|
@ -174,17 +174,18 @@
|
||||||
(defclass C-base2 () ())
|
(defclass C-base2 () ())
|
||||||
(defclass C (C-base1 C-base2) ())
|
(defclass C (C-base1 C-base2) ())
|
||||||
|
|
||||||
|
;; Just use the obsolete name once, to make sure it also works.
|
||||||
(defmethod constructor :STATIC ((p C-base1) &rest args)
|
(defmethod constructor :STATIC ((p C-base1) &rest args)
|
||||||
(eieio-test-method-store)
|
(eieio-test-method-store)
|
||||||
(if (next-method-p) (call-next-method))
|
(if (next-method-p) (call-next-method))
|
||||||
)
|
)
|
||||||
|
|
||||||
(defmethod constructor :STATIC ((p C-base2) &rest args)
|
(defmethod eieio-constructor :STATIC ((p C-base2) &rest args)
|
||||||
(eieio-test-method-store)
|
(eieio-test-method-store)
|
||||||
(if (next-method-p) (call-next-method))
|
(if (next-method-p) (call-next-method))
|
||||||
)
|
)
|
||||||
|
|
||||||
(defmethod constructor :STATIC ((p C) &rest args)
|
(defmethod eieio-constructor :STATIC ((p C) &rest args)
|
||||||
(eieio-test-method-store)
|
(eieio-test-method-store)
|
||||||
(call-next-method)
|
(call-next-method)
|
||||||
)
|
)
|
||||||
|
|
|
||||||
|
|
@ -175,7 +175,7 @@ persistent class.")
|
||||||
|
|
||||||
(defclass persistent-with-objs-slot-subs (eieio-persistent)
|
(defclass persistent-with-objs-slot-subs (eieio-persistent)
|
||||||
((pnp :initarg :pnp
|
((pnp :initarg :pnp
|
||||||
:type (or null persist-not-persistent-child)
|
:type (or null persist-not-persistent)
|
||||||
:initform nil))
|
:initform nil))
|
||||||
"Class for testing the saving of slots with objects in them.")
|
"Class for testing the saving of slots with objects in them.")
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -157,7 +157,7 @@
|
||||||
(ert-deftest eieio-test-02-abstract-class ()
|
(ert-deftest eieio-test-02-abstract-class ()
|
||||||
;; Abstract classes cannot be instantiated, so this should throw an
|
;; Abstract classes cannot be instantiated, so this should throw an
|
||||||
;; error
|
;; error
|
||||||
(should-error (abstract-class "Test")))
|
(should-error (abstract-class)))
|
||||||
|
|
||||||
(defgeneric generic1 () "First generic function")
|
(defgeneric generic1 () "First generic function")
|
||||||
|
|
||||||
|
|
@ -179,7 +179,7 @@
|
||||||
"Method generic1 that can take a non-object."
|
"Method generic1 that can take a non-object."
|
||||||
not-an-object)
|
not-an-object)
|
||||||
|
|
||||||
(let ((ans-obj (generic1 (class-a "test")))
|
(let ((ans-obj (generic1 (class-a)))
|
||||||
(ans-num (generic1 666)))
|
(ans-num (generic1 666)))
|
||||||
(should (eq ans-obj 'monkey))
|
(should (eq ans-obj 'monkey))
|
||||||
(should (eq ans-num 666))))
|
(should (eq ans-num 666))))
|
||||||
|
|
@ -200,7 +200,7 @@ Argument C is the class bound to this static method."
|
||||||
;; Call static method on a class and see if it worked
|
;; Call static method on a class and see if it worked
|
||||||
(static-method-class-method static-method-class 'class)
|
(static-method-class-method static-method-class 'class)
|
||||||
(should (eq (oref static-method-class some-slot) 'class))
|
(should (eq (oref static-method-class some-slot) 'class))
|
||||||
(static-method-class-method (static-method-class "test") 'object)
|
(static-method-class-method (static-method-class) 'object)
|
||||||
(should (eq (oref static-method-class some-slot) 'object)))
|
(should (eq (oref static-method-class some-slot) 'object)))
|
||||||
|
|
||||||
(ert-deftest eieio-test-05-static-method-2 ()
|
(ert-deftest eieio-test-05-static-method-2 ()
|
||||||
|
|
@ -216,7 +216,7 @@ Argument C is the class bound to this static method."
|
||||||
|
|
||||||
(static-method-class-method static-method-class-2 'class)
|
(static-method-class-method static-method-class-2 'class)
|
||||||
(should (eq (oref static-method-class-2 some-slot) 'moose-class))
|
(should (eq (oref static-method-class-2 some-slot) 'moose-class))
|
||||||
(static-method-class-method (static-method-class-2 "test") 'object)
|
(static-method-class-method (static-method-class-2) 'object)
|
||||||
(should (eq (oref static-method-class-2 some-slot) 'moose-object)))
|
(should (eq (oref static-method-class-2 some-slot) 'moose-object)))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -230,14 +230,14 @@ Argument C is the class bound to this static method."
|
||||||
(defvar eitest-b nil)
|
(defvar eitest-b nil)
|
||||||
(ert-deftest eieio-test-06-allocate-objects ()
|
(ert-deftest eieio-test-06-allocate-objects ()
|
||||||
;; allocate an object to use
|
;; allocate an object to use
|
||||||
(should (setq eitest-ab (class-ab "abby")))
|
(should (setq eitest-ab (class-ab)))
|
||||||
(should (setq eitest-a (class-a "aye")))
|
(should (setq eitest-a (class-a)))
|
||||||
(should (setq eitest-b (class-b "fooby"))))
|
(should (setq eitest-b (class-b))))
|
||||||
|
|
||||||
(ert-deftest eieio-test-07-make-instance ()
|
(ert-deftest eieio-test-07-make-instance ()
|
||||||
(should (make-instance 'class-ab))
|
(should (make-instance 'class-ab))
|
||||||
(should (make-instance 'class-a :water 'cho))
|
(should (make-instance 'class-a :water 'cho))
|
||||||
(should (make-instance 'class-b "a name")))
|
(should (make-instance 'class-b)))
|
||||||
|
|
||||||
(defmethod class-cn ((a class-a))
|
(defmethod class-cn ((a class-a))
|
||||||
"Try calling `call-next-method' when there isn't one.
|
"Try calling `call-next-method' when there isn't one.
|
||||||
|
|
@ -354,7 +354,7 @@ METHOD is the method that was attempting to be called."
|
||||||
(call-next-method)
|
(call-next-method)
|
||||||
(oset a test-tag 1))
|
(oset a test-tag 1))
|
||||||
|
|
||||||
(let ((ca (class-a "class act")))
|
(let ((ca (class-a)))
|
||||||
(should-not (/= (oref ca test-tag) 2))))
|
(should-not (/= (oref ca test-tag) 2))))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -403,7 +403,7 @@ METHOD is the method that was attempting to be called."
|
||||||
(t (call-next-method))))
|
(t (call-next-method))))
|
||||||
|
|
||||||
(ert-deftest eieio-test-17-virtual-slot ()
|
(ert-deftest eieio-test-17-virtual-slot ()
|
||||||
(setq eitest-vsca (virtual-slot-class "eitest-vsca" :base-value 1))
|
(setq eitest-vsca (virtual-slot-class :base-value 1))
|
||||||
;; Check slot values
|
;; Check slot values
|
||||||
(should (= (oref eitest-vsca :base-value) 1))
|
(should (= (oref eitest-vsca :base-value) 1))
|
||||||
(should (= (oref eitest-vsca :derived-value) 2))
|
(should (= (oref eitest-vsca :derived-value) 2))
|
||||||
|
|
@ -418,7 +418,7 @@ METHOD is the method that was attempting to be called."
|
||||||
|
|
||||||
;; should also be possible to initialize instance using virtual slot
|
;; should also be possible to initialize instance using virtual slot
|
||||||
|
|
||||||
(setq eitest-vscb (virtual-slot-class "eitest-vscb" :derived-value 5))
|
(setq eitest-vscb (virtual-slot-class :derived-value 5))
|
||||||
(should (= (oref eitest-vscb :base-value) 4))
|
(should (= (oref eitest-vscb :base-value) 4))
|
||||||
(should (= (oref eitest-vscb :derived-value) 5)))
|
(should (= (oref eitest-vscb :derived-value) 5)))
|
||||||
|
|
||||||
|
|
@ -444,7 +444,7 @@ METHOD is the method that was attempting to be called."
|
||||||
;; After setting 'water to 'moose, make sure a new object has
|
;; After setting 'water to 'moose, make sure a new object has
|
||||||
;; the right stuff.
|
;; the right stuff.
|
||||||
(oset-default (eieio-object-class eitest-a) water 'penguin)
|
(oset-default (eieio-object-class eitest-a) water 'penguin)
|
||||||
(should (eq (oref (class-a "foo") water) 'penguin))
|
(should (eq (oref (class-a) water) 'penguin))
|
||||||
|
|
||||||
;; Revert the above
|
;; Revert the above
|
||||||
(defmethod slot-unbound ((a class-a) &rest foo)
|
(defmethod slot-unbound ((a class-a) &rest foo)
|
||||||
|
|
@ -458,12 +458,12 @@ METHOD is the method that was attempting to be called."
|
||||||
;; We should not be able to set a string here
|
;; We should not be able to set a string here
|
||||||
(should-error (oset eitest-ab water "a string, not a symbol") :type 'invalid-slot-type)
|
(should-error (oset eitest-ab water "a string, not a symbol") :type 'invalid-slot-type)
|
||||||
(should-error (oset eitest-ab classslot "a string, not a symbol") :type 'invalid-slot-type)
|
(should-error (oset eitest-ab classslot "a string, not a symbol") :type 'invalid-slot-type)
|
||||||
(should-error (class-a "broken-type-a" :water "a string not a symbol") :type 'invalid-slot-type))
|
(should-error (class-a :water "a string not a symbol") :type 'invalid-slot-type))
|
||||||
|
|
||||||
(ert-deftest eieio-test-20-class-allocated-slots ()
|
(ert-deftest eieio-test-20-class-allocated-slots ()
|
||||||
;; Test out class allocated slots
|
;; Test out class allocated slots
|
||||||
(defvar eitest-aa nil)
|
(defvar eitest-aa nil)
|
||||||
(setq eitest-aa (class-a "another"))
|
(setq eitest-aa (class-a))
|
||||||
|
|
||||||
;; Make sure class slots do not track between objects
|
;; Make sure class slots do not track between objects
|
||||||
(let ((newval 'moose))
|
(let ((newval 'moose))
|
||||||
|
|
@ -498,7 +498,7 @@ METHOD is the method that was attempting to be called."
|
||||||
(ert-deftest eieio-test-21-eval-at-construction-time ()
|
(ert-deftest eieio-test-21-eval-at-construction-time ()
|
||||||
;; initforms that need to be evalled at construction time.
|
;; initforms that need to be evalled at construction time.
|
||||||
(setq eieio-test-permuting-value 2)
|
(setq eieio-test-permuting-value 2)
|
||||||
(setq eitest-pvinit (inittest "permuteme"))
|
(setq eitest-pvinit (inittest))
|
||||||
|
|
||||||
(should (eq (oref eitest-pvinit staticval) 1))
|
(should (eq (oref eitest-pvinit staticval) 1))
|
||||||
(should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value))
|
(should (eq (oref eitest-pvinit symval) 'eieio-test-permuting-value))
|
||||||
|
|
@ -514,11 +514,11 @@ METHOD is the method that was attempting to be called."
|
||||||
"Test class that will be a calculated value.")
|
"Test class that will be a calculated value.")
|
||||||
|
|
||||||
(defclass eitest-superior nil
|
(defclass eitest-superior nil
|
||||||
((sub :initform (eitest-subordinate "test")
|
((sub :initform (eitest-subordinate)
|
||||||
:type eitest-subordinate))
|
:type eitest-subordinate))
|
||||||
"A class with an initform that creates a class.")
|
"A class with an initform that creates a class.")
|
||||||
|
|
||||||
(should (setq eitest-tests (eitest-superior "test")))
|
(should (setq eitest-tests (eitest-superior)))
|
||||||
|
|
||||||
(should-error
|
(should-error
|
||||||
(eval
|
(eval
|
||||||
|
|
@ -546,8 +546,8 @@ METHOD is the method that was attempting to be called."
|
||||||
(should (not (class-a-child-p "foo"))))
|
(should (not (class-a-child-p "foo"))))
|
||||||
|
|
||||||
(ert-deftest eieio-test-24-object-predicates ()
|
(ert-deftest eieio-test-24-object-predicates ()
|
||||||
(let ((listooa (list (class-ab "ab") (class-a "a")))
|
(let ((listooa (list (class-ab) (class-a)))
|
||||||
(listoob (list (class-ab "ab") (class-b "b"))))
|
(listoob (list (class-ab) (class-b))))
|
||||||
(should (class-a-list-p listooa))
|
(should (class-a-list-p listooa))
|
||||||
(should (class-b-list-p listoob))
|
(should (class-b-list-p listoob))
|
||||||
(should-not (class-b-list-p listooa))
|
(should-not (class-b-list-p listooa))
|
||||||
|
|
@ -555,7 +555,7 @@ METHOD is the method that was attempting to be called."
|
||||||
|
|
||||||
(defvar eitest-t1 nil)
|
(defvar eitest-t1 nil)
|
||||||
(ert-deftest eieio-test-25-slot-tests ()
|
(ert-deftest eieio-test-25-slot-tests ()
|
||||||
(setq eitest-t1 (class-c "C1"))
|
(setq eitest-t1 (class-c))
|
||||||
;; Slot initialization
|
;; Slot initialization
|
||||||
(should (eq (oref eitest-t1 slot-1) 'moose))
|
(should (eq (oref eitest-t1 slot-1) 'moose))
|
||||||
(should (eq (oref eitest-t1 :moose) 'moose))
|
(should (eq (oref eitest-t1 :moose) 'moose))
|
||||||
|
|
@ -564,7 +564,7 @@ METHOD is the method that was attempting to be called."
|
||||||
;; Check private slot accessor
|
;; Check private slot accessor
|
||||||
(should (string= (get-slot-2 eitest-t1) "penguin"))
|
(should (string= (get-slot-2 eitest-t1) "penguin"))
|
||||||
;; Pass string instead of symbol
|
;; Pass string instead of symbol
|
||||||
(should-error (class-c "C2" :moose "not a symbol") :type 'invalid-slot-type)
|
(should-error (class-c :moose "not a symbol") :type 'invalid-slot-type)
|
||||||
(should (eq (get-slot-3 eitest-t1) 'emu))
|
(should (eq (get-slot-3 eitest-t1) 'emu))
|
||||||
(should (eq (get-slot-3 class-c) 'emu))
|
(should (eq (get-slot-3 class-c) 'emu))
|
||||||
;; Check setf
|
;; Check setf
|
||||||
|
|
@ -576,13 +576,13 @@ METHOD is the method that was attempting to be called."
|
||||||
(defvar eitest-t2 nil)
|
(defvar eitest-t2 nil)
|
||||||
(ert-deftest eieio-test-26-default-inheritance ()
|
(ert-deftest eieio-test-26-default-inheritance ()
|
||||||
;; See previous test, nor for subclass
|
;; See previous test, nor for subclass
|
||||||
(setq eitest-t2 (class-subc "subc"))
|
(setq eitest-t2 (class-subc))
|
||||||
(should (eq (oref eitest-t2 slot-1) 'moose))
|
(should (eq (oref eitest-t2 slot-1) 'moose))
|
||||||
(should (eq (oref eitest-t2 :moose) 'moose))
|
(should (eq (oref eitest-t2 :moose) 'moose))
|
||||||
(should (string= (get-slot-2 eitest-t2) "linux"))
|
(should (string= (get-slot-2 eitest-t2) "linux"))
|
||||||
(should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
|
(should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
|
||||||
(should (string= (get-slot-2 eitest-t2) "linux"))
|
(should (string= (get-slot-2 eitest-t2) "linux"))
|
||||||
(should-error (class-subc "C2" :moose "not a symbol") :type 'invalid-slot-type))
|
(should-error (class-subc :moose "not a symbol") :type 'invalid-slot-type))
|
||||||
|
|
||||||
;;(ert-deftest eieio-test-27-inherited-new-value ()
|
;;(ert-deftest eieio-test-27-inherited-new-value ()
|
||||||
;;; HACK ALERT: The new value of a class slot is inherited by the
|
;;; HACK ALERT: The new value of a class slot is inherited by the
|
||||||
|
|
@ -646,8 +646,8 @@ Do not override for `prot-2'."
|
||||||
(defvar eitest-p1 nil)
|
(defvar eitest-p1 nil)
|
||||||
(defvar eitest-p2 nil)
|
(defvar eitest-p2 nil)
|
||||||
(ert-deftest eieio-test-28-slot-protection ()
|
(ert-deftest eieio-test-28-slot-protection ()
|
||||||
(setq eitest-p1 (prot-1 ""))
|
(setq eitest-p1 (prot-1))
|
||||||
(setq eitest-p2 (prot-2 ""))
|
(setq eitest-p2 (prot-2))
|
||||||
;; Access public slots
|
;; Access public slots
|
||||||
(oref eitest-p1 slot-1)
|
(oref eitest-p1 slot-1)
|
||||||
(oref eitest-p2 slot-1)
|
(oref eitest-p2 slot-1)
|
||||||
|
|
@ -742,7 +742,7 @@ Subclasses to override slot attributes.")
|
||||||
"This class should throw an error.")))
|
"This class should throw an error.")))
|
||||||
|
|
||||||
;; Initform should override instance allocation
|
;; Initform should override instance allocation
|
||||||
(let ((obj (slotattr-ok "moose")))
|
(let ((obj (slotattr-ok)))
|
||||||
(should (eq (oref obj initform) 'no-init))))
|
(should (eq (oref obj initform) 'no-init))))
|
||||||
|
|
||||||
(defclass slotattr-class-base ()
|
(defclass slotattr-class-base ()
|
||||||
|
|
@ -825,7 +825,7 @@ Subclasses to override slot attributes.")
|
||||||
|
|
||||||
(ert-deftest eieio-test-32-test-clone-boring-objects ()
|
(ert-deftest eieio-test-32-test-clone-boring-objects ()
|
||||||
;; A simple make instance with EIEIO extension
|
;; A simple make instance with EIEIO extension
|
||||||
(should (setq eitest-CLONETEST1 (make-instance 'class-a "a")))
|
(should (setq eitest-CLONETEST1 (make-instance 'class-a)))
|
||||||
(should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1)))
|
(should (setq eitest-CLONETEST2 (clone eitest-CLONETEST1)))
|
||||||
|
|
||||||
;; CLOS form of make-instance
|
;; CLOS form of make-instance
|
||||||
|
|
@ -839,7 +839,7 @@ Subclasses to override slot attributes.")
|
||||||
|
|
||||||
(ert-deftest eieio-test-33-instance-tracker ()
|
(ert-deftest eieio-test-33-instance-tracker ()
|
||||||
(let (IT-list IT1)
|
(let (IT-list IT1)
|
||||||
(should (setq IT1 (IT "trackme")))
|
(should (setq IT1 (IT)))
|
||||||
;; The instance tracker must find this
|
;; The instance tracker must find this
|
||||||
(should (eieio-instance-tracker-find 'die 'slot1 'IT-list))
|
(should (eieio-instance-tracker-find 'die 'slot1 'IT-list))
|
||||||
;; Test deletion
|
;; Test deletion
|
||||||
|
|
@ -851,8 +851,8 @@ Subclasses to override slot attributes.")
|
||||||
"A Singleton test object.")
|
"A Singleton test object.")
|
||||||
|
|
||||||
(ert-deftest eieio-test-34-singletons ()
|
(ert-deftest eieio-test-34-singletons ()
|
||||||
(let ((obj1 (SINGLE "Moose"))
|
(let ((obj1 (SINGLE))
|
||||||
(obj2 (SINGLE "Cow")))
|
(obj2 (SINGLE)))
|
||||||
(should (eieio-object-p obj1))
|
(should (eieio-object-p obj1))
|
||||||
(should (eieio-object-p obj2))
|
(should (eieio-object-p obj2))
|
||||||
(should (eq obj1 obj2))
|
(should (eq obj1 obj2))
|
||||||
|
|
@ -865,7 +865,7 @@ Subclasses to override slot attributes.")
|
||||||
|
|
||||||
(ert-deftest eieio-test-35-named-object ()
|
(ert-deftest eieio-test-35-named-object ()
|
||||||
(let (N)
|
(let (N)
|
||||||
(should (setq N (NAMED "Foo")))
|
(should (setq N (NAMED :object-name "Foo")))
|
||||||
(should (string= "Foo" (oref N object-name)))
|
(should (string= "Foo" (oref N object-name)))
|
||||||
(should-error (oref N missing-slot) :type 'invalid-slot-name)
|
(should-error (oref N missing-slot) :type 'invalid-slot-name)
|
||||||
(oset N object-name "NewName")
|
(oset N object-name "NewName")
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue