From ee93d7ad4291a0946efe3197481cfbeff92f29b8 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 22 Dec 2014 22:05:46 -0500 Subject: [PATCH] * lisp/emacs-lisp/eieio*.el: Remove "name" field of objects * lisp/emacs-lisp/eieio-base.el (clone) : 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) : Remove. (eieio-object-name-string, eieio-object-set-name-string, clone) : 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. --- lisp/ChangeLog | 34 ++++++++++ lisp/emacs-lisp/eieio-base.el | 80 ++++++++++------------- lisp/emacs-lisp/eieio-core.el | 55 ++++++++++------ lisp/emacs-lisp/eieio-custom.el | 4 +- lisp/emacs-lisp/eieio.el | 60 ++++++++--------- test/automated/eieio-test-methodinvoke.el | 5 +- test/automated/eieio-test-persist.el | 2 +- test/automated/eieio-tests.el | 62 +++++++++--------- 8 files changed, 167 insertions(+), 135 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 739d442c55b..1a0383814cd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,37 @@ +2014-12-23 Stefan Monnier + + * 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) : + 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) : Remove. + (eieio-object-name-string, eieio-object-set-name-string, clone) + : New methods. + 2014-12-22 Stefan Monnier * emacs-lisp/eieio-core.el (eieio--class-v): Rename from class-v. diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index f2020dfa74d..8a09dac2dff 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -63,25 +63,10 @@ SLOT-NAME is the offending slot. FN is the function signaling the error." ;; Throw the regular signal. (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. All slots are unbound, except those initialized with PARAMS." - (let ((nobj (make-vector (length obj) eieio-unbound)) - (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))) + (let ((nobj (call-next-method))) (oset nobj parent-instance obj) 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." :abstract t) -(defmethod constructor :STATIC ((class eieio-singleton) _name &rest _slots) +(defmethod eieio-constructor :STATIC ((class eieio-singleton) &rest _slots) "Constructor for singleton CLASS. NAME and SLOTS initialize the new object. 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 identified, and needing more object creation." (let ((objclass (nth 0 inputlist)) - (objname (nth 1 inputlist)) + ;; (objname (nth 1 inputlist)) (slots (nthcdr 2 inputlist)) (createslots nil)) @@ -293,7 +278,7 @@ identified, and needing more object creation." (setq slots (cdr (cdr slots)))) - (apply 'make-instance objclass objname (nreverse createslots)) + (apply #'make-instance objclass (nreverse createslots)) ;;(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)) (type 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)) slot-idx)) @@ -463,34 +449,38 @@ instance." ;;; Named object -;; -;; Named objects use the objects `name' as a slot, and that slot -;; is accessed with the `object-name' symbol. (defclass eieio-named () - () - "Object with a name. -Name storage already occurs in an object. This object provides get/set -access to it." + ((object-name :initarg :object-name :initform nil)) + "Object with a name." :abstract t) -(defmethod slot-missing ((obj eieio-named) - slot-name operation &optional new-value) - "Called when a non-existent slot is accessed. -For variable `eieio-named', provide an imaginary `object-name' slot. -Argument OBJ is the named object. -Argument SLOT-NAME is the slot that was attempted to be accessed. -OPERATION is the type of access, such as `oref' or `oset'. -NEW-VALUE is the value that was being set into SLOT if OPERATION were -a set type." - (if (memq slot-name '(object-name :object-name)) - (cond ((eq operation 'oset) - (if (not (stringp new-value)) - (signal 'invalid-slot-type - (list obj slot-name 'string new-value))) - (eieio-object-set-name-string obj new-value)) - (t (eieio-object-name-string obj))) - (call-next-method))) +(defmethod eieio-object-name-string ((obj eieio-named)) + "Return a string which is OBJ's name." + (or (slot-value obj 'object-name) + (symbol-name (eieio-object-class obj)))) + +(defmethod eieio-object-set-name-string ((obj eieio-named) name) + "Set the string which is OBJ's NAME." + (eieio--check-type stringp name) + (eieio-oset obj 'object-name name)) + +(defmethod clone ((obj eieio-named) &rest params) + "Clone OBJ, initializing `:parent' to OBJ. +All slots are unbound, except those initialized with PARAMS." + (let* ((newname (and (stringp (car params)) (pop params))) + (nobj (apply #'call-next-method obj params)) + (nm (slot-value obj 'object-name))) + (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) diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el index 1e8d17d2652..299df8db378 100644 --- a/lisp/emacs-lisp/eieio-core.el +++ b/lisp/emacs-lisp/eieio-core.el @@ -39,6 +39,9 @@ "Like `defalias', but with less side-effects. More specifically, it has no side-effects at all when the new function 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) (eq (symbol-function name) body)) (defalias name body))) @@ -167,8 +170,7 @@ Stored outright without modifications or stripping."))) (eieio--define-field-accessors object (-unused-0 ;;Constant slot, set to `object'. - (class "class struct defining OBJ") - name)) ;FIXME: Get rid of this field! + (class "class struct defining OBJ"))) ;; FIXME: The constants below should have an `eieio-' prefix added!! (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 (let ((csym (intern (concat (symbol-name cname) "-p")))) (fset csym - (list 'lambda (list 'obj) - (format "Test OBJ to see if it an object of type %s" cname) - (list 'and '(eieio-object-p obj) - (list 'same-class-p 'obj cname))))) + `(lambda (obj) + ,(format "Test OBJ to see if it an object of type %s" cname) + (and (eieio-object-p obj) + (same-class-p obj ',cname))))) ;; Make sure the method invocation order is a valid value. (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" cname) (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 ;; 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. (fset cname - `(lambda (newname &rest slots) + `(lambda (&rest slots) ,(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. @@ -761,7 +768,6 @@ See `defclass' for more information." nil))) (aset cache 0 'object) (setf (eieio--object-class cache) cname) - (setf (eieio--object-name cache) 'default-cache-object) (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.. @@ -1087,6 +1093,10 @@ the new child class." (defun eieio--defgeneric-init-form (method doc-string) "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 ((or (not (fboundp method)) (eq 'autoload (car-safe (symbol-function method)))) @@ -1198,6 +1208,11 @@ but remove reference to all implementations of METHOD." ;; Primary key. ;; (t eieio--method-primary) (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). (eieio--defalias method (eieio--defgeneric-init-form @@ -1253,7 +1268,7 @@ an error." (if eieio-skip-typecheck nil ;; 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))) (if (not (eieio-perform-slot-validation 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)) ) (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)) 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))) (eieio-validate-slot-value class c value slot) ;; 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) ;; Take the value, and put it into our cache object. (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) (cond ((not (cdr fsym)) - (+ 3 fsi)) + (+ (eval-when-compile eieio--object-num-slots) fsi)) ((and (eq (cdr fsym) 'protected) (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))))) - (+ 3 fsi)) + (+ (eval-when-compile eieio--object-num-slots) fsi)) ((and (eq (cdr fsym) 'private) (or (and (eieio--scoped-class) (eieio-slot-originating-class-p (eieio--scoped-class) slot)) eieio-initializing-object)) - (+ 3 fsi)) + (+ (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))))) @@ -1778,12 +1795,8 @@ for this common case to improve performance." (setq mclass (eieio--object-class firstarg))) ((not firstarg) (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 - (error "EIEIO Error: Improperly classified method %s as primary only" - method) - )) + (error "Primary-only method %s called on something not an object" method))) ;; Make sure the class is a valid class ;; mclass can be nil (meaning a generic for should be used. ;; mclass cannot have a value that is not a class, however. diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 189337bd5f9..8172cbeef6f 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -70,7 +70,7 @@ of these.") :documentation "A number of thingies.")) "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." :type 'object :group 'eieio) @@ -317,7 +317,7 @@ Optional argument IGNORE is an extraneous parameter." fgroup (cdr fgroup) fcust (cdr fcust))) ;; 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. obj)) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index f4e1d246011..51b8c3d2b4a 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -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 class is used as the name slot instead when INITARGS doesn't start with a string." - (if (and (car initargs) (stringp (car initargs))) - (apply (class-constructor class) initargs) - (apply (class-constructor class) - (cond ((symbolp class) (symbol-name class)) - (t (format "%S" class))) - initargs))) + (apply (class-constructor class) initargs)) ;;; 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." (eieio--check-type eieio-object-p 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") -(defun eieio-object-name-string (obj) "Return a string which is OBJ's name." - (eieio--check-type eieio-object-p obj) - (eieio--object-name obj)) +(defconst eieio--object-names (make-hash-table :test #'eq :weakness 'key)) + +;; 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 '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." - (eieio--check-type eieio-object-p obj) + (declare (obsolete eieio-named "25.1")) (eieio--check-type stringp name) - (setf (eieio--object-name obj) name)) + (setf (gethash obj eieio--object-names) name)) (define-obsolete-function-alias '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) -(defgeneric constructor (class newname &rest slots) +(defgeneric eieio-constructor (class &rest slots) "Default constructor for CLASS `eieio-default-superclass'.") -(defmethod constructor :static - ((class eieio-default-superclass) newname &rest slots) +(define-obsolete-function-alias 'constructor #'eieio-constructor "25.1") + +(defmethod eieio-constructor :static + ((class eieio-default-superclass) &rest slots) "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'. This static method is called when an object is constructed. It allocates the vector used to represent an EIEIO object, and then calls `shared-initialize' on that object." (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 ;; that were passed down to us. (initialize-instance new-object slots) @@ -715,18 +717,10 @@ first and modify the returned object.") (defmethod clone ((obj eieio-default-superclass) &rest params) "Make a copy of OBJ, and then apply PARAMS." - (let ((nobj (copy-sequence obj)) - (nm (eieio--object-name obj)) - (passname (and params (stringp (car params)))) - (num 1)) - (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))) + (let ((nobj (copy-sequence obj))) + (if (stringp (car params)) + (message "Obsolete name %S passed to clone" (pop params))) + (if params (shared-initialize nobj params)) nobj)) (defgeneric destructor (this &rest params) @@ -889,7 +883,7 @@ variable PRINT-FUNCTION. Optional argument NOESCAPE is passed to ;;; 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 (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 (autoload 'eieio-browse "eieio-opt" "\ diff --git a/test/automated/eieio-test-methodinvoke.el b/test/automated/eieio-test-methodinvoke.el index 20b47a771d8..3f86d8fcc99 100644 --- a/test/automated/eieio-test-methodinvoke.el +++ b/test/automated/eieio-test-methodinvoke.el @@ -174,17 +174,18 @@ (defclass 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) (eieio-test-method-store) (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) (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) (call-next-method) ) diff --git a/test/automated/eieio-test-persist.el b/test/automated/eieio-test-persist.el index d6f53cd9db2..00de3cf0d7c 100644 --- a/test/automated/eieio-test-persist.el +++ b/test/automated/eieio-test-persist.el @@ -175,7 +175,7 @@ persistent class.") (defclass persistent-with-objs-slot-subs (eieio-persistent) ((pnp :initarg :pnp - :type (or null persist-not-persistent-child) + :type (or null persist-not-persistent) :initform nil)) "Class for testing the saving of slots with objects in them.") diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el index 87151f6a0da..91ddfc4fcf3 100644 --- a/test/automated/eieio-tests.el +++ b/test/automated/eieio-tests.el @@ -157,7 +157,7 @@ (ert-deftest eieio-test-02-abstract-class () ;; Abstract classes cannot be instantiated, so this should throw an ;; error - (should-error (abstract-class "Test"))) + (should-error (abstract-class))) (defgeneric generic1 () "First generic function") @@ -179,7 +179,7 @@ "Method generic1 that can take a non-object." not-an-object) - (let ((ans-obj (generic1 (class-a "test"))) + (let ((ans-obj (generic1 (class-a))) (ans-num (generic1 666))) (should (eq ans-obj 'monkey)) (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 (static-method-class-method static-method-class '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))) (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) (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))) @@ -230,14 +230,14 @@ Argument C is the class bound to this static method." (defvar eitest-b nil) (ert-deftest eieio-test-06-allocate-objects () ;; allocate an object to use - (should (setq eitest-ab (class-ab "abby"))) - (should (setq eitest-a (class-a "aye"))) - (should (setq eitest-b (class-b "fooby")))) + (should (setq eitest-ab (class-ab))) + (should (setq eitest-a (class-a))) + (should (setq eitest-b (class-b)))) (ert-deftest eieio-test-07-make-instance () (should (make-instance 'class-ab)) (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)) "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) (oset a test-tag 1)) - (let ((ca (class-a "class act"))) + (let ((ca (class-a))) (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)))) (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 (should (= (oref eitest-vsca :base-value) 1)) (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 - (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 :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 ;; the right stuff. (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 (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 (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 (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 () ;; Test out class allocated slots (defvar eitest-aa nil) - (setq eitest-aa (class-a "another")) + (setq eitest-aa (class-a)) ;; Make sure class slots do not track between objects (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 () ;; initforms that need to be evalled at construction time. (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 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.") (defclass eitest-superior nil - ((sub :initform (eitest-subordinate "test") + ((sub :initform (eitest-subordinate) :type eitest-subordinate)) "A class with an initform that creates a class.") - (should (setq eitest-tests (eitest-superior "test"))) + (should (setq eitest-tests (eitest-superior))) (should-error (eval @@ -546,8 +546,8 @@ METHOD is the method that was attempting to be called." (should (not (class-a-child-p "foo")))) (ert-deftest eieio-test-24-object-predicates () - (let ((listooa (list (class-ab "ab") (class-a "a"))) - (listoob (list (class-ab "ab") (class-b "b")))) + (let ((listooa (list (class-ab) (class-a))) + (listoob (list (class-ab) (class-b)))) (should (class-a-list-p listooa)) (should (class-b-list-p listoob)) (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) (ert-deftest eieio-test-25-slot-tests () - (setq eitest-t1 (class-c "C1")) + (setq eitest-t1 (class-c)) ;; Slot initialization (should (eq (oref eitest-t1 slot-1) '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 (should (string= (get-slot-2 eitest-t1) "penguin")) ;; 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 class-c) 'emu)) ;; Check setf @@ -576,13 +576,13 @@ METHOD is the method that was attempting to be called." (defvar eitest-t2 nil) (ert-deftest eieio-test-26-default-inheritance () ;; 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 :moose) 'moose)) (should (string= (get-slot-2 eitest-t2) "linux")) (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name) (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 () ;;; 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-p2 nil) (ert-deftest eieio-test-28-slot-protection () - (setq eitest-p1 (prot-1 "")) - (setq eitest-p2 (prot-2 "")) + (setq eitest-p1 (prot-1)) + (setq eitest-p2 (prot-2)) ;; Access public slots (oref eitest-p1 slot-1) (oref eitest-p2 slot-1) @@ -742,7 +742,7 @@ Subclasses to override slot attributes.") "This class should throw an error."))) ;; Initform should override instance allocation - (let ((obj (slotattr-ok "moose"))) + (let ((obj (slotattr-ok))) (should (eq (oref obj initform) 'no-init)))) (defclass slotattr-class-base () @@ -825,7 +825,7 @@ Subclasses to override slot attributes.") (ert-deftest eieio-test-32-test-clone-boring-objects () ;; 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))) ;; CLOS form of make-instance @@ -839,7 +839,7 @@ Subclasses to override slot attributes.") (ert-deftest eieio-test-33-instance-tracker () (let (IT-list IT1) - (should (setq IT1 (IT "trackme"))) + (should (setq IT1 (IT))) ;; The instance tracker must find this (should (eieio-instance-tracker-find 'die 'slot1 'IT-list)) ;; Test deletion @@ -851,8 +851,8 @@ Subclasses to override slot attributes.") "A Singleton test object.") (ert-deftest eieio-test-34-singletons () - (let ((obj1 (SINGLE "Moose")) - (obj2 (SINGLE "Cow"))) + (let ((obj1 (SINGLE)) + (obj2 (SINGLE))) (should (eieio-object-p obj1)) (should (eieio-object-p obj2)) (should (eq obj1 obj2)) @@ -865,7 +865,7 @@ Subclasses to override slot attributes.") (ert-deftest eieio-test-35-named-object () (let (N) - (should (setq N (NAMED "Foo"))) + (should (setq N (NAMED :object-name "Foo"))) (should (string= "Foo" (oref N object-name))) (should-error (oref N missing-slot) :type 'invalid-slot-name) (oset N object-name "NewName") -- 2.39.2