Don't enforce :protection in EIEIO objects any more
* doc/misc/eieio.texi (Slot Options): Document :protection as unsupported. * lisp/emacs-lisp/eieio-core.el (eieio--scoped-class-stack): Remove var. (eieio--scoped-class): Remove function. (eieio--with-scoped-class): Remove macro. Replace uses with `progn'. (eieio--slot-name-index): Don't check the :protection anymore. (eieio-initializing-object): Remove var. (eieio-set-defaults): Don't let-bind eieio-initializing-object. * lisp/emacs-lisp/eieio-generic.el (call-next-method): Don't bother checking eieio--scoped-class any more. * test/automated/eieio-test-methodinvoke.el (eieio-test-method-store): Use an explicit arg instead of eieio--scoped-class. Update all callers. * test/automated/eieio-tests.el (eieio-test-25-slot-tests) (eieio-test-26-default-inheritance, eieio-test-28-slot-protection) (eieio-test-30-slot-attribute-override) (eieio-test-31-slot-attribute-override-class-allocation): Don't check that we enforce :protection since we don't any more.
This commit is contained in:
Stefan Monnier
parent
24b7f77581
commit
d48c98cda8
10 changed files with 159 additions and 183 deletions
|
|
@ -1,3 +1,7 @@
|
|||
2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* eieio.texi (Slot Options): Document :protection as unsupported.
|
||||
|
||||
2015-01-01 Michael Albinus <michael.albinus@gmx.de>
|
||||
|
||||
Sync with Tramp 2.2.11.
|
||||
|
|
@ -24,7 +28,7 @@
|
|||
|
||||
2014-12-18 Eric Abrahamsen <eric@ericabrahamsen.net>
|
||||
|
||||
* gnus.texi (Gnus Registry Setup): Explain pruning changes. Mention
|
||||
* gnus.texi (Gnus Registry Setup): Explain pruning changes. Mention
|
||||
gnus-registry-prune-factor. Explain sorting changes and
|
||||
gnus-registry-default-sort-function. Correct file extension.
|
||||
|
||||
|
|
|
|||
|
|
@ -538,10 +538,15 @@ to quote the symbol. If you wanted to run a function on load, you
|
|||
can output the code to do the construction of the value.
|
||||
|
||||
@item :protection
|
||||
This is an old option that is not supported any more.
|
||||
|
||||
When using a slot referencing function such as @code{slot-value}, and
|
||||
the value behind @var{slot} is private or protected, then the current
|
||||
scope of operation must be within a method of the calling object.
|
||||
|
||||
This protection is not enforced by the code any more, so it's only useful
|
||||
as documentation.
|
||||
|
||||
Valid values are:
|
||||
|
||||
@table @code
|
||||
|
|
|
|||
1
etc/NEWS
1
etc/NEWS
|
|
@ -202,6 +202,7 @@ the old behavior -- *shell* buffer displays in current window -- use
|
|||
|
||||
|
||||
** EIEIO
|
||||
*** The `:protection' slot option is not obeyed any more.
|
||||
*** The <class>-list-p and <class>-child-p functions are declared obsolete.
|
||||
*** The <class> variables are declared obsolete.
|
||||
*** The <initarg> variables are declared obsolete.
|
||||
|
|
|
|||
|
|
@ -1,3 +1,15 @@
|
|||
2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* emacs-lisp/eieio-generic.el (call-next-method): Don't bother checking
|
||||
eieio--scoped-class any more.
|
||||
|
||||
* emacs-lisp/eieio-core.el (eieio--scoped-class-stack): Remove var.
|
||||
(eieio--scoped-class): Remove function.
|
||||
(eieio--with-scoped-class): Remove macro. Replace uses with `progn'.
|
||||
(eieio--slot-name-index): Don't check the :protection anymore.
|
||||
(eieio-initializing-object): Remove var.
|
||||
(eieio-set-defaults): Don't let-bind eieio-initializing-object.
|
||||
|
||||
2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
Improve handling of doc-strings and describe-function for cl-generic.
|
||||
|
|
|
|||
|
|
@ -62,9 +62,6 @@ default setting for optimization purposes.")
|
|||
(defvar eieio-optimize-primary-methods-flag t
|
||||
"Non-nil means to optimize the method dispatch on primary methods.")
|
||||
|
||||
(defvar eieio-initializing-object nil
|
||||
"Set to non-nil while initializing an object.")
|
||||
|
||||
(defvar eieio-backward-compatibility t
|
||||
"If nil, drop support for some behaviors of older versions of EIEIO.
|
||||
Currently under control of this var:
|
||||
|
|
@ -82,29 +79,6 @@ Currently under control of this var:
|
|||
;; while it is being built itself.
|
||||
(defvar eieio-default-superclass nil)
|
||||
|
||||
;;;
|
||||
;; Class currently in scope.
|
||||
;;
|
||||
;; When invoking methods, the running method needs to know which class
|
||||
;; is currently in scope. Generally this is the class of the method
|
||||
;; being called, but 'call-next-method' needs to query this state,
|
||||
;; and change it to be then next super class up.
|
||||
;;
|
||||
;; Thus, the scoped class is a stack that needs to be managed.
|
||||
|
||||
(defvar eieio--scoped-class-stack nil
|
||||
"A stack of the classes currently in scope during method invocation.")
|
||||
|
||||
(defun eieio--scoped-class ()
|
||||
"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))
|
||||
`(let ((eieio--scoped-class-stack (cons ,class eieio--scoped-class-stack)))
|
||||
,@forms))
|
||||
|
||||
(progn
|
||||
;; Arrange for field access not to bother checking if the access is indeed
|
||||
;; made to an eieio--class object.
|
||||
|
|
@ -1029,27 +1003,26 @@ Fills in the default value in CLASS' in SLOT with VALUE."
|
|||
(setq class (eieio--class-object class))
|
||||
(eieio--check-type eieio--class-p class)
|
||||
(eieio--check-type symbolp slot)
|
||||
(eieio--with-scoped-class class
|
||||
(let* ((c (eieio--slot-name-index class nil 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 class slot))
|
||||
(progn
|
||||
;; Oref that slot.
|
||||
(eieio--validate-class-slot-value class c value slot)
|
||||
(aset (eieio--class-class-allocation-values class) c
|
||||
value))
|
||||
(signal 'invalid-slot-name (list (eieio--class-symbol class) slot)))
|
||||
(eieio--validate-slot-value class c value slot)
|
||||
;; Set this into the storage for defaults.
|
||||
(setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
|
||||
(eieio--class-public-d class))
|
||||
value)
|
||||
;; Take the value, and put it into our cache object.
|
||||
(eieio-oset (eieio--class-default-object-cache class)
|
||||
slot value)
|
||||
))))
|
||||
(let* ((c (eieio--slot-name-index class nil 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 class slot))
|
||||
(progn
|
||||
;; Oref that slot.
|
||||
(eieio--validate-class-slot-value class c value slot)
|
||||
(aset (eieio--class-class-allocation-values class) c
|
||||
value))
|
||||
(signal 'invalid-slot-name (list (eieio--class-symbol class) slot)))
|
||||
(eieio--validate-slot-value class c value slot)
|
||||
;; Set this into the storage for defaults.
|
||||
(setcar (nthcdr (- c (eval-when-compile eieio--object-num-slots))
|
||||
(eieio--class-public-d class))
|
||||
value)
|
||||
;; Take the value, and put it into our cache object.
|
||||
(eieio-oset (eieio--class-default-object-cache class)
|
||||
slot value)
|
||||
)))
|
||||
|
||||
|
||||
;;; EIEIO internal search functions
|
||||
|
|
@ -1080,27 +1053,7 @@ reverse-lookup that name, and recurse with the associated slot value."
|
|||
(let* ((fsym (gethash slot (eieio--class-symbol-hashtable class)))
|
||||
(fsi (car fsym)))
|
||||
(if (integerp fsi)
|
||||
(cond
|
||||
((not (cdr fsym))
|
||||
(+ (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)
|
||||
;; AFAICT, for all callers, if `obj' is not a class,
|
||||
;; then its class is `class'.
|
||||
;;(child-of-class-p class (eieio--object-class-object obj))
|
||||
(progn
|
||||
(cl-assert (eq class (eieio--object-class-object obj)))
|
||||
t))))
|
||||
(+ (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))
|
||||
(+ (eval-when-compile eieio--object-num-slots) fsi))
|
||||
(t nil))
|
||||
(+ (eval-when-compile eieio--object-num-slots) fsi)
|
||||
(let ((fn (eieio--initarg-to-attribute class slot)))
|
||||
(if fn (eieio--slot-name-index class obj fn) nil)))))
|
||||
|
||||
|
|
@ -1128,14 +1081,12 @@ 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-object obj)
|
||||
(let ((eieio-initializing-object t)
|
||||
(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))))))
|
||||
(let ((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)
|
||||
"For CLASS, convert INITARG to the actual attribute name.
|
||||
|
|
|
|||
|
|
@ -174,8 +174,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 (eieio--class-v class)
|
||||
(apply impl local-args)))))))
|
||||
(apply impl local-args))))))
|
||||
|
||||
(defun eieio-unbind-method-implementations (method)
|
||||
"Make the generic method METHOD have no implementations.
|
||||
|
|
@ -287,11 +286,9 @@ This should only be called from a generic function."
|
|||
)
|
||||
;; Now create a list in reverse order of all the calls we have
|
||||
;; make in order to successfully do this right. Rules:
|
||||
;; 1) Only call generics if scoped-class is not defined
|
||||
;; This prevents multiple calls in the case of recursion
|
||||
;; 2) Only call static if this is a static method.
|
||||
;; 3) Only call specifics if the definition allows for them.
|
||||
;; 4) Call in order based on :before, :primary, and :after
|
||||
;; 1) Only call static if this is a static method.
|
||||
;; 2) Only call specifics if the definition allows for them.
|
||||
;; 3) Call in order based on :before, :primary, and :after
|
||||
(when (eieio-object-p firstarg)
|
||||
;; Non-static calls do all this stuff.
|
||||
|
||||
|
|
@ -357,22 +354,21 @@ 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))
|
||||
(let* ((eieio--generic-call-key (car keys))
|
||||
(has-return-val
|
||||
(or (= eieio--generic-call-key eieio--method-primary)
|
||||
(= eieio--generic-call-key eieio--method-static)))
|
||||
(eieio--generic-call-next-method-list
|
||||
;; Use the cdr, as the first element is the fcn
|
||||
;; we are calling right now.
|
||||
(when has-return-val (cdr primarymethodlist)))
|
||||
)
|
||||
(setq found t)
|
||||
;;(setq rval (apply (car (car lambdas)) newargs))
|
||||
(setq lastval (apply (car (car lambdas)) newargs))
|
||||
(when has-return-val
|
||||
(setq rval lastval))
|
||||
)))
|
||||
(let* ((eieio--generic-call-key (car keys))
|
||||
(has-return-val
|
||||
(or (= eieio--generic-call-key eieio--method-primary)
|
||||
(= eieio--generic-call-key eieio--method-static)))
|
||||
(eieio--generic-call-next-method-list
|
||||
;; Use the cdr, as the first element is the fcn
|
||||
;; we are calling right now.
|
||||
(when has-return-val (cdr primarymethodlist)))
|
||||
)
|
||||
(setq found t)
|
||||
;;(setq rval (apply (car (car lambdas)) newargs))
|
||||
(setq lastval (apply (car (car lambdas)) newargs))
|
||||
(when has-return-val
|
||||
(setq rval lastval))
|
||||
))
|
||||
(setq lambdas (cdr lambdas)
|
||||
keys (cdr keys)))
|
||||
(if (not found)
|
||||
|
|
@ -425,33 +421,32 @@ 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)
|
||||
(let* ((rval nil) (lastval nil)
|
||||
(eieio--generic-call-key eieio--method-primary)
|
||||
;; Use the cdr, as the first element is the fcn
|
||||
;; we are calling right now.
|
||||
(eieio--generic-call-next-method-list (cdr primarymethodlist))
|
||||
)
|
||||
(let* ((rval nil) (lastval nil)
|
||||
(eieio--generic-call-key eieio--method-primary)
|
||||
;; Use the cdr, as the first element is the fcn
|
||||
;; we are calling right now.
|
||||
(eieio--generic-call-next-method-list (cdr primarymethodlist))
|
||||
)
|
||||
|
||||
(if (or (not lambdas) (not (car lambdas)))
|
||||
(if (or (not lambdas) (not (car lambdas)))
|
||||
|
||||
;; No methods found for this impl...
|
||||
(if (eieio-object-p (car args))
|
||||
(setq rval (apply #'no-applicable-method
|
||||
(car args) method args))
|
||||
(signal
|
||||
'no-method-definition
|
||||
(list method args)))
|
||||
;; No methods found for this impl...
|
||||
(if (eieio-object-p (car args))
|
||||
(setq rval (apply #'no-applicable-method
|
||||
(car args) method args))
|
||||
(signal
|
||||
'no-method-definition
|
||||
(list method args)))
|
||||
|
||||
;; Do the regular implementation here.
|
||||
;; Do the regular implementation here.
|
||||
|
||||
(run-hook-with-args 'eieio-pre-method-execution-functions
|
||||
lambdas)
|
||||
(run-hook-with-args 'eieio-pre-method-execution-functions
|
||||
lambdas)
|
||||
|
||||
(setq lastval (apply (car lambdas) newargs))
|
||||
(setq rval lastval))
|
||||
(setq lastval (apply (car lambdas) newargs))
|
||||
(setq rval lastval))
|
||||
|
||||
rval))))
|
||||
rval)))
|
||||
|
||||
(defun eieio--mt-method-list (method key class)
|
||||
"Return an alist list of methods lambdas.
|
||||
|
|
@ -721,8 +716,6 @@ If REPLACEMENT-ARGS is non-nil, then use them instead of
|
|||
arguments passed in at the top level.
|
||||
|
||||
Use `next-method-p' to find out if there is a next method to call."
|
||||
(if (not (eieio--scoped-class))
|
||||
(error "`call-next-method' not called within a class specific method"))
|
||||
(if (and (/= eieio--generic-call-key eieio--method-primary)
|
||||
(/= eieio--generic-call-key eieio--method-static))
|
||||
(error "Cannot `call-next-method' except in :primary or :static methods")
|
||||
|
|
@ -737,8 +730,7 @@ Use `next-method-p' to find out if there is a next method to call."
|
|||
(eieio--generic-call-arglst newargs)
|
||||
(fcn (car next))
|
||||
)
|
||||
(eieio--with-scoped-class (cdr next)
|
||||
(apply fcn newargs)) ))))
|
||||
(apply fcn newargs)) )))
|
||||
|
||||
(defgeneric no-applicable-method (object method &rest args)
|
||||
"Called if there are no implementations for OBJECT in METHOD.")
|
||||
|
|
|
|||
|
|
@ -76,8 +76,6 @@ being the slots residing in that class definition. Supported tags are:
|
|||
- A string documenting use of this slot.
|
||||
|
||||
The following are extensions on CLOS:
|
||||
:protection - Specify protection for this slot.
|
||||
Defaults to `:public'. Also use `:protected', or `:private'.
|
||||
:custom - When customizing an object, the custom :type. Public only.
|
||||
:label - A text string label used for a slot when customizing.
|
||||
:group - Name of a customization group this slot belongs in.
|
||||
|
|
@ -672,14 +670,13 @@ 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-object obj)
|
||||
(while 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)))))
|
||||
(setq slots (cdr (cdr slots))))))
|
||||
(while 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)))))
|
||||
(setq slots (cdr (cdr slots)))))
|
||||
|
||||
(defgeneric initialize-instance (this &optional slots)
|
||||
"Construct the new object THIS based on SLOTS.")
|
||||
|
|
|
|||
|
|
@ -1,7 +1,18 @@
|
|||
2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* automated/eieio-test-methodinvoke.el (eieio-test-cl-generic-1): Reset
|
||||
eieio-test--1.
|
||||
* automated/eieio-tests.el (eieio-test-25-slot-tests)
|
||||
(eieio-test-26-default-inheritance, eieio-test-28-slot-protection)
|
||||
(eieio-test-30-slot-attribute-override)
|
||||
(eieio-test-31-slot-attribute-override-class-allocation): Don't check
|
||||
that we enforce :protection since we don't any more.
|
||||
|
||||
* automated/eieio-test-methodinvoke.el (eieio-test-method-store):
|
||||
Use an explicit arg instead of eieio--scoped-class. Update all callers.
|
||||
|
||||
2015-01-17 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* automated/eieio-test-methodinvoke.el (eieio-test-cl-generic-1):
|
||||
Reset eieio-test--1.
|
||||
|
||||
* automated/cl-generic-tests.el (cl-generic-test-8-after/before):
|
||||
Rename from cl-generic-test-7-after/before.
|
||||
|
|
|
|||
|
|
@ -58,11 +58,9 @@
|
|||
(defvar eieio-test-method-order-list nil
|
||||
"List of symbols stored during method invocation.")
|
||||
|
||||
(defun eieio-test-method-store (keysym)
|
||||
(defun eieio-test-method-store (&rest args)
|
||||
"Store current invocation class symbol in the invocation order list."
|
||||
;; FIXME: Don't depend on `eieio--scoped-class'!
|
||||
(let* ((c (list keysym (eieio--class-symbol (eieio--scoped-class)))))
|
||||
(push c eieio-test-method-order-list)))
|
||||
(push args eieio-test-method-order-list))
|
||||
|
||||
(defun eieio-test-match (rightanswer)
|
||||
"Do a test match."
|
||||
|
|
@ -86,36 +84,36 @@
|
|||
(defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
|
||||
|
||||
(defmethod eitest-F :BEFORE ((p eitest-B-base1))
|
||||
(eieio-test-method-store :BEFORE))
|
||||
(eieio-test-method-store :BEFORE 'eitest-B-base1))
|
||||
|
||||
(defmethod eitest-F :BEFORE ((p eitest-B-base2))
|
||||
(eieio-test-method-store :BEFORE))
|
||||
(eieio-test-method-store :BEFORE 'eitest-B-base2))
|
||||
|
||||
(defmethod eitest-F :BEFORE ((p eitest-B))
|
||||
(eieio-test-method-store :BEFORE))
|
||||
(eieio-test-method-store :BEFORE 'eitest-B))
|
||||
|
||||
(defmethod eitest-F ((p eitest-B))
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'eitest-B)
|
||||
(call-next-method))
|
||||
|
||||
(defmethod eitest-F ((p eitest-B-base1))
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'eitest-B-base1)
|
||||
(call-next-method))
|
||||
|
||||
(defmethod eitest-F ((p eitest-B-base2))
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'eitest-B-base2)
|
||||
(when (next-method-p)
|
||||
(call-next-method))
|
||||
)
|
||||
|
||||
(defmethod eitest-F :AFTER ((p eitest-B-base1))
|
||||
(eieio-test-method-store :AFTER))
|
||||
(eieio-test-method-store :AFTER 'eitest-B-base1))
|
||||
|
||||
(defmethod eitest-F :AFTER ((p eitest-B-base2))
|
||||
(eieio-test-method-store :AFTER))
|
||||
(eieio-test-method-store :AFTER 'eitest-B-base2))
|
||||
|
||||
(defmethod eitest-F :AFTER ((p eitest-B))
|
||||
(eieio-test-method-store :AFTER))
|
||||
(eieio-test-method-store :AFTER 'eitest-B))
|
||||
|
||||
(ert-deftest eieio-test-method-order-list-3 ()
|
||||
(let ((eieio-test-method-order-list nil)
|
||||
|
|
@ -150,15 +148,15 @@
|
|||
;;; Return value from :PRIMARY
|
||||
;;
|
||||
(defmethod eitest-I :BEFORE ((a eitest-A))
|
||||
(eieio-test-method-store :BEFORE)
|
||||
(eieio-test-method-store :BEFORE 'eitest-A)
|
||||
":before")
|
||||
|
||||
(defmethod eitest-I :PRIMARY ((a eitest-A))
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'eitest-A)
|
||||
":primary")
|
||||
|
||||
(defmethod eitest-I :AFTER ((a eitest-A))
|
||||
(eieio-test-method-store :AFTER)
|
||||
(eieio-test-method-store :AFTER 'eitest-A)
|
||||
":after")
|
||||
|
||||
(ert-deftest eieio-test-method-order-list-5 ()
|
||||
|
|
@ -177,17 +175,17 @@
|
|||
|
||||
;; Just use the obsolete name once, to make sure it also works.
|
||||
(defmethod constructor :STATIC ((p C-base1) &rest args)
|
||||
(eieio-test-method-store :STATIC)
|
||||
(eieio-test-method-store :STATIC 'C-base1)
|
||||
(if (next-method-p) (call-next-method))
|
||||
)
|
||||
|
||||
(defmethod eieio-constructor :STATIC ((p C-base2) &rest args)
|
||||
(eieio-test-method-store :STATIC)
|
||||
(eieio-test-method-store :STATIC 'C-base2)
|
||||
(if (next-method-p) (call-next-method))
|
||||
)
|
||||
|
||||
(defmethod eieio-constructor :STATIC ((p C) &rest args)
|
||||
(eieio-test-method-store :STATIC)
|
||||
(eieio-test-method-store :STATIC 'C)
|
||||
(call-next-method)
|
||||
)
|
||||
|
||||
|
|
@ -214,24 +212,24 @@
|
|||
|
||||
(defmethod eitest-F ((p D))
|
||||
"D"
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'D)
|
||||
(call-next-method))
|
||||
|
||||
(defmethod eitest-F ((p D-base0))
|
||||
"D-base0"
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'D-base0)
|
||||
;; This should have no next
|
||||
;; (when (next-method-p) (call-next-method))
|
||||
)
|
||||
|
||||
(defmethod eitest-F ((p D-base1))
|
||||
"D-base1"
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'D-base1)
|
||||
(call-next-method))
|
||||
|
||||
(defmethod eitest-F ((p D-base2))
|
||||
"D-base2"
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'D-base2)
|
||||
(when (next-method-p)
|
||||
(call-next-method))
|
||||
)
|
||||
|
|
@ -256,21 +254,21 @@
|
|||
(defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
|
||||
|
||||
(defmethod eitest-F ((p E))
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'E)
|
||||
(call-next-method))
|
||||
|
||||
(defmethod eitest-F ((p E-base0))
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'E-base0)
|
||||
;; This should have no next
|
||||
;; (when (next-method-p) (call-next-method))
|
||||
)
|
||||
|
||||
(defmethod eitest-F ((p E-base1))
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'E-base1)
|
||||
(call-next-method))
|
||||
|
||||
(defmethod eitest-F ((p E-base2))
|
||||
(eieio-test-method-store :PRIMARY)
|
||||
(eieio-test-method-store :PRIMARY 'E-base2)
|
||||
(when (next-method-p)
|
||||
(call-next-method))
|
||||
)
|
||||
|
|
|
|||
|
|
@ -563,7 +563,7 @@ METHOD is the method that was attempting to be called."
|
|||
(should (eq (oref eitest-t1 slot-1) 'moose))
|
||||
(should (eq (oref eitest-t1 :moose) 'moose))
|
||||
;; Don't pass reference of private slot
|
||||
(should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name)
|
||||
;;PRIVATE (should-error (oref eitest-t1 slot-2) :type 'invalid-slot-name)
|
||||
;; Check private slot accessor
|
||||
(should (string= (get-slot-2 eitest-t1) "penguin"))
|
||||
;; Pass string instead of symbol
|
||||
|
|
@ -583,7 +583,7 @@ METHOD is the method that was attempting to be called."
|
|||
(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)
|
||||
;;PRIVATE (should-error (oref eitest-t2 slot-2) :type 'invalid-slot-name)
|
||||
(should (string= (get-slot-2 eitest-t2) "linux"))
|
||||
(should-error (class-subc :moose "not a symbol") :type 'invalid-slot-type))
|
||||
|
||||
|
|
@ -654,20 +654,23 @@ Do not override for `prot-2'."
|
|||
;; Access public slots
|
||||
(oref eitest-p1 slot-1)
|
||||
(oref eitest-p2 slot-1)
|
||||
;; Accessing protected slot out of context must fail
|
||||
(should-error (oref eitest-p1 slot-2) :type 'invalid-slot-name)
|
||||
;; Accessing protected slot out of context used to fail, but we dropped this
|
||||
;; feature, since it was underused and noone noticed that the check was
|
||||
;; incorrect (much too loose).
|
||||
;;PROTECTED (should-error (oref eitest-p1 slot-2) :type 'invalid-slot-name)
|
||||
;; Access protected slot in method
|
||||
(prot1-slot-2 eitest-p1)
|
||||
;; Protected slot in subclass method
|
||||
(prot1-slot-2 eitest-p2)
|
||||
;; Protected slot from parent class method
|
||||
(prot0-slot-2 eitest-p1)
|
||||
;; Accessing private slot out of context must fail
|
||||
(should-error (oref eitest-p1 slot-3) :type 'invalid-slot-name)
|
||||
;; Accessing private slot out of context used to fail, but we dropped this
|
||||
;; feature, since it was not used.
|
||||
;;PRIVATE (should-error (oref eitest-p1 slot-3) :type 'invalid-slot-name)
|
||||
;; Access private slot in method
|
||||
(prot1-slot-3 eitest-p1)
|
||||
;; Access private slot in subclass method must fail
|
||||
(should-error (prot1-slot-3 eitest-p2) :type 'invalid-slot-name)
|
||||
;;PRIVATE (should-error (prot1-slot-3 eitest-p2) :type 'invalid-slot-name)
|
||||
;; Access private slot by same class
|
||||
(prot1-slot-3-only eitest-p1)
|
||||
;; Access private slot by subclass in sameclass method
|
||||
|
|
@ -729,12 +732,13 @@ Subclasses to override slot attributes.")
|
|||
|
||||
(ert-deftest eieio-test-30-slot-attribute-override ()
|
||||
;; Subclass should not override :protection slot attribute
|
||||
(should-error
|
||||
(eval
|
||||
'(defclass slotattr-fail (slotattr-base)
|
||||
((protection :protection :public)
|
||||
)
|
||||
"This class should throw an error.")))
|
||||
;;PROTECTION is gone.
|
||||
;;(should-error
|
||||
;; (eval
|
||||
;; '(defclass slotattr-fail (slotattr-base)
|
||||
;; ((protection :protection :public)
|
||||
;; )
|
||||
;; "This class should throw an error.")))
|
||||
|
||||
;; Subclass should not override :type slot attribute
|
||||
(should-error
|
||||
|
|
@ -782,12 +786,13 @@ Subclasses to override slot attributes.")
|
|||
|
||||
(ert-deftest eieio-test-31-slot-attribute-override-class-allocation ()
|
||||
;; Same as test-30, but with class allocation
|
||||
(should-error
|
||||
(eval
|
||||
'(defclass slotattr-fail (slotattr-class-base)
|
||||
((protection :protection :public)
|
||||
)
|
||||
"This class should throw an error.")))
|
||||
;;PROTECTION is gone.
|
||||
;;(should-error
|
||||
;; (eval
|
||||
;; '(defclass slotattr-fail (slotattr-class-base)
|
||||
;; ((protection :protection :public)
|
||||
;; )
|
||||
;; "This class should throw an error.")))
|
||||
(should-error
|
||||
(eval
|
||||
'(defclass slotattr-fail (slotattr-class-base)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue