(defclass eitest-B-base2 () ())
(defclass eitest-B (eitest-B-base1 eitest-B-base2) ())
-(defmethod eitest-F :BEFORE ((_p eitest-B-base1))
- (eieio-test-method-store :BEFORE 'eitest-B-base1))
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric)
+ (obsolete call-next-method)
+ (obsolete next-method-p))
+ (defmethod eitest-F :BEFORE ((_p eitest-B-base1))
+ (eieio-test-method-store :BEFORE 'eitest-B-base1))
-(defmethod eitest-F :BEFORE ((_p eitest-B-base2))
- (eieio-test-method-store :BEFORE 'eitest-B-base2))
+ (defmethod eitest-F :BEFORE ((_p eitest-B-base2))
+ (eieio-test-method-store :BEFORE 'eitest-B-base2))
-(defmethod eitest-F :BEFORE ((_p eitest-B))
- (eieio-test-method-store :BEFORE 'eitest-B))
+ (defmethod eitest-F :BEFORE ((_p eitest-B))
+ (eieio-test-method-store :BEFORE 'eitest-B))
-(defmethod eitest-F ((_p eitest-B))
- (eieio-test-method-store :PRIMARY 'eitest-B)
- (call-next-method))
-
-(defmethod eitest-F ((_p eitest-B-base1))
- (eieio-test-method-store :PRIMARY 'eitest-B-base1)
- (call-next-method))
+ (defmethod eitest-F ((_p eitest-B))
+ (eieio-test-method-store :PRIMARY 'eitest-B)
+ (call-next-method))
-(defmethod eitest-F ((_p eitest-B-base2))
- (eieio-test-method-store :PRIMARY 'eitest-B-base2)
- (when (next-method-p)
+ (defmethod eitest-F ((_p eitest-B-base1))
+ (eieio-test-method-store :PRIMARY 'eitest-B-base1)
(call-next-method))
- )
-(defmethod eitest-F :AFTER ((_p eitest-B-base1))
- (eieio-test-method-store :AFTER 'eitest-B-base1))
+ (defmethod eitest-F ((_p eitest-B-base2))
+ (eieio-test-method-store :PRIMARY 'eitest-B-base2)
+ (when (next-method-p)
+ (call-next-method)))
-(defmethod eitest-F :AFTER ((_p eitest-B-base2))
- (eieio-test-method-store :AFTER 'eitest-B-base2))
+ (defmethod eitest-F :AFTER ((_p eitest-B-base1))
+ (eieio-test-method-store :AFTER 'eitest-B-base1))
-(defmethod eitest-F :AFTER ((_p eitest-B))
- (eieio-test-method-store :AFTER 'eitest-B))
+ (defmethod eitest-F :AFTER ((_p eitest-B-base2))
+ (eieio-test-method-store :AFTER 'eitest-B-base2))
+
+ (defmethod eitest-F :AFTER ((_p eitest-B))
+ (eieio-test-method-store :AFTER 'eitest-B)))
(ert-deftest eieio-test-method-order-list-3 ()
(let ((eieio-test-method-order-list nil)
;;; Test static invocation
;;
-(defmethod eitest-H :STATIC ((_class eitest-A))
- "No need to do work in here."
- 'moose)
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod eitest-H :STATIC ((_class eitest-A))
+ "No need to do work in here."
+ 'moose))
(ert-deftest eieio-test-method-order-list-4 ()
;; Both of these situations should succeed.
;;; Return value from :PRIMARY
;;
-(defmethod eitest-I :BEFORE ((_a eitest-A))
- (eieio-test-method-store :BEFORE 'eitest-A)
- ":before")
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod eitest-I :BEFORE ((_a eitest-A))
+ (eieio-test-method-store :BEFORE 'eitest-A)
+ ":before")
-(defmethod eitest-I :PRIMARY ((_a eitest-A))
- (eieio-test-method-store :PRIMARY 'eitest-A)
- ":primary")
+ (defmethod eitest-I :PRIMARY ((_a eitest-A))
+ (eieio-test-method-store :PRIMARY 'eitest-A)
+ ":primary")
-(defmethod eitest-I :AFTER ((_a eitest-A))
- (eieio-test-method-store :AFTER 'eitest-A)
- ":after")
+ (defmethod eitest-I :AFTER ((_a eitest-A))
+ (eieio-test-method-store :AFTER 'eitest-A)
+ ":after"))
(ert-deftest eieio-test-method-order-list-5 ()
(let ((eieio-test-method-order-list nil)
(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 :STATIC 'C-base1)
- (if (next-method-p) (call-next-method))
- )
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric)
+ (obsolete next-method-p)
+ (obsolete call-next-method))
+ ;; 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 'C-base1)
+ (if (next-method-p) (call-next-method)))
-(defmethod make-instance :STATIC ((_p C-base2) &rest _args)
- (eieio-test-method-store :STATIC 'C-base2)
- (if (next-method-p) (call-next-method))
- )
+ (defmethod make-instance :STATIC ((_p C-base2) &rest _args)
+ (eieio-test-method-store :STATIC 'C-base2)
+ (if (next-method-p) (call-next-method))))
(cl-defmethod make-instance ((_p (subclass C)) &rest _args)
(eieio-test-method-store :STATIC 'C)
(defclass D-base2 (D-base0) () :method-invocation-order :depth-first)
(defclass D (D-base1 D-base2) () :method-invocation-order :depth-first)
-(defmethod eitest-F ((_p D))
- "D"
- (eieio-test-method-store :PRIMARY 'D)
- (call-next-method))
-
-(defmethod eitest-F ((_p D-base0))
- "D-base0"
- (eieio-test-method-store :PRIMARY 'D-base0)
- ;; This should have no next
- ;; (when (next-method-p) (call-next-method))
- )
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric)
+ (obsolete call-next-method)
+ (obsolete next-method-p))
+ (defmethod eitest-F ((_p D))
+ "D"
+ (eieio-test-method-store :PRIMARY 'D)
+ (call-next-method))
-(defmethod eitest-F ((_p D-base1))
- "D-base1"
- (eieio-test-method-store :PRIMARY 'D-base1)
- (call-next-method))
+ (defmethod eitest-F ((_p D-base0))
+ "D-base0"
+ (eieio-test-method-store :PRIMARY 'D-base0)
+ ;; This should have no next
+ ;; (when (next-method-p) (call-next-method))
+ )
-(defmethod eitest-F ((_p D-base2))
- "D-base2"
- (eieio-test-method-store :PRIMARY 'D-base2)
- (when (next-method-p)
+ (defmethod eitest-F ((_p D-base1))
+ "D-base1"
+ (eieio-test-method-store :PRIMARY 'D-base1)
(call-next-method))
- )
+
+ (defmethod eitest-F ((_p D-base2))
+ "D-base2"
+ (eieio-test-method-store :PRIMARY 'D-base2)
+ (when (next-method-p)
+ (call-next-method))))
(ert-deftest eieio-test-method-order-list-7 ()
(let ((eieio-test-method-order-list nil)
(defclass E-base2 (E-base0) () :method-invocation-order :breadth-first)
(defclass E (E-base1 E-base2) () :method-invocation-order :breadth-first)
-(defmethod eitest-F ((_p E))
- (eieio-test-method-store :PRIMARY 'E)
- (call-next-method))
-
-(defmethod eitest-F ((_p E-base0))
- (eieio-test-method-store :PRIMARY 'E-base0)
- ;; This should have no next
- ;; (when (next-method-p) (call-next-method))
- )
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete next-method-p)
+ (obsolete call-next-method))
+ (defmethod eitest-F ((_p E))
+ (eieio-test-method-store :PRIMARY 'E)
+ (call-next-method))
-(defmethod eitest-F ((_p E-base1))
- (eieio-test-method-store :PRIMARY 'E-base1)
- (call-next-method))
+ (defmethod eitest-F ((_p E-base0))
+ (eieio-test-method-store :PRIMARY 'E-base0)
+ ;; This should have no next
+ ;; (when (next-method-p) (call-next-method))
+ )
-(defmethod eitest-F ((_p E-base2))
- (eieio-test-method-store :PRIMARY 'E-base2)
- (when (next-method-p)
+ (defmethod eitest-F ((_p E-base1))
+ (eieio-test-method-store :PRIMARY 'E-base1)
(call-next-method))
- )
+
+ (defmethod eitest-F ((_p E-base2))
+ (eieio-test-method-store :PRIMARY 'E-base2)
+ (when (next-method-p)
+ (call-next-method))))
(ert-deftest eieio-test-method-order-list-8 ()
(let ((eieio-test-method-order-list nil)
(defclass eitest-Ja ()
())
-(defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots)
- ;(message "+Ja")
- ;; FIXME: Using next-method-p in an after-method is invalid!
- (when (next-method-p)
- (call-next-method))
- ;(message "-Ja")
- )
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric)
+ (obsolete next-method-p)
+ (obsolete call-next-method))
+ (defmethod initialize-instance :after ((_this eitest-Ja) &rest _slots)
+ ;;(message "+Ja")
+ ;; FIXME: Using next-method-p in an after-method is invalid!
+ (when (next-method-p)
+ (call-next-method))
+ ;;(message "-Ja")
+ ))
(defclass eitest-Jb ()
())
-(defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots)
- ;(message "+Jb")
- ;; FIXME: Using next-method-p in an after-method is invalid!
- (when (next-method-p)
- (call-next-method))
- ;(message "-Jb")
- )
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete next-method-p)
+ (obsolete call-next-method))
+ (defmethod initialize-instance :after ((_this eitest-Jb) &rest _slots)
+ ;;(message "+Jb")
+ ;; FIXME: Using next-method-p in an after-method is invalid!
+ (when (next-method-p)
+ (call-next-method))
+ ;;(message "-Jb")
+ ))
(defclass eitest-Jc (eitest-Jb)
())
(defclass eitest-Jd (eitest-Jc eitest-Ja)
())
-(defmethod initialize-instance ((_this eitest-Jd) &rest _slots)
- ;(message "+Jd")
- (when (next-method-p)
- (call-next-method))
- ;(message "-Jd")
- )
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric)
+ (obsolete next-method-p)
+ (obsolete call-next-method))
+ (defmethod initialize-instance ((_this eitest-Jd) &rest _slots)
+ ;;(message "+Jd")
+ (when (next-method-p)
+ (call-next-method))
+ ;;(message "-Jd")
+ ))
(ert-deftest eieio-test-method-order-list-9 ()
(should (eitest-Jd)))
(defclass CNM-2 (CNM-1-1 CNM-1-2)
())
-(defmethod CNM-M ((this CNM-0) args)
- (push (cons 'CNM-0 (copy-sequence args))
- eieio-test-call-next-method-arguments)
- (when (next-method-p)
- (call-next-method
- this (cons 'CNM-0 args))))
-
-(defmethod CNM-M ((this CNM-1-1) args)
- (push (cons 'CNM-1-1 (copy-sequence args))
- eieio-test-call-next-method-arguments)
- (when (next-method-p)
- (call-next-method
- this (cons 'CNM-1-1 args))))
-
-(defmethod CNM-M ((_this CNM-1-2) args)
- (push (cons 'CNM-1-2 (copy-sequence args))
- eieio-test-call-next-method-arguments)
- (when (next-method-p)
- (call-next-method)))
-
-(defmethod CNM-M ((this CNM-2) args)
- (push (cons 'CNM-2 (copy-sequence args))
- eieio-test-call-next-method-arguments)
- (when (next-method-p)
- (call-next-method
- this (cons 'CNM-2 args))))
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric)
+ (obsolete next-method-p)
+ (obsolete call-next-method))
+ (defmethod CNM-M ((this CNM-0) args)
+ (push (cons 'CNM-0 (copy-sequence args))
+ eieio-test-call-next-method-arguments)
+ (when (next-method-p)
+ (call-next-method
+ this (cons 'CNM-0 args))))
+
+ (defmethod CNM-M ((this CNM-1-1) args)
+ (push (cons 'CNM-1-1 (copy-sequence args))
+ eieio-test-call-next-method-arguments)
+ (when (next-method-p)
+ (call-next-method
+ this (cons 'CNM-1-1 args))))
+
+ (defmethod CNM-M ((_this CNM-1-2) args)
+ (push (cons 'CNM-1-2 (copy-sequence args))
+ eieio-test-call-next-method-arguments)
+ (when (next-method-p)
+ (call-next-method)))
+
+ (defmethod CNM-M ((this CNM-2) args)
+ (push (cons 'CNM-2 (copy-sequence args))
+ eieio-test-call-next-method-arguments)
+ (when (next-method-p)
+ (call-next-method
+ this (cons 'CNM-2 args)))))
(ert-deftest eieio-test-method-order-list-10 ()
(let ((eieio-test-call-next-method-arguments nil))
;; error
(should-error (abstract-class)))
-(defgeneric generic1 () "First generic function.")
+(with-suppressed-warnings ((obsolete defgeneric))
+ (defgeneric generic1 () "First generic function."))
(ert-deftest eieio-test-03-generics ()
- (defun anormalfunction () "A plain function for error testing." nil)
- (should-error
- (progn
- (defgeneric anormalfunction ()
- "Attempt to turn it into a generic.")))
-
- ;; Check that generic-p works
- (should (generic-p 'generic1))
-
- (defmethod generic1 ((_c class-a))
- "Method on generic1."
- 'monkey)
-
- (defmethod generic1 (not-an-object)
- "Method generic1 that can take a non-object."
- not-an-object)
-
- (let ((ans-obj (generic1 (class-a)))
- (ans-num (generic1 666)))
- (should (eq ans-obj 'monkey))
- (should (eq ans-num 666))))
+ (with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defun anormalfunction () "A plain function for error testing." nil)
+ (should-error
+ (progn
+ (defgeneric anormalfunction ()
+ "Attempt to turn it into a generic.")))
+
+ ;; Check that generic-p works
+ (should (generic-p 'generic1))
+
+ (defmethod generic1 ((_c class-a))
+ "Method on generic1."
+ 'monkey)
+
+ (defmethod generic1 (not-an-object)
+ "Method generic1 that can take a non-object."
+ not-an-object)
+
+ (let ((ans-obj (generic1 (class-a)))
+ (ans-num (generic1 666)))
+ (should (eq ans-obj 'monkey))
+ (should (eq ans-num 666)))))
(defclass static-method-class ()
((some-slot :initform nil
:documentation "A slot."))
:documentation "A class used for testing static methods.")
-(defmethod static-method-class-method :STATIC ((c static-method-class) value)
- "Test static methods.
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod static-method-class-method :STATIC ((c static-method-class) value)
+ "Test static methods.
Argument C is the class bound to this static method."
- (if (eieio-object-p c) (setq c (eieio-object-class c)))
- (oset-default c some-slot value))
+ (if (eieio-object-p c) (setq c (eieio-object-class c)))
+ (oset-default c some-slot value)))
(ert-deftest eieio-test-04-static-method ()
;; Call static method on a class and see if it worked
()
"A second class after the previous for static methods.")
- (defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
- "Test static methods.
+ (with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod static-method-class-method :STATIC ((c static-method-class-2) value)
+ "Test static methods.
Argument C is the class bound to this static method."
- (if (eieio-object-p c) (setq c (eieio-object-class c)))
- (oset-default c some-slot (intern (concat "moose-" (symbol-name value)))))
+ (if (eieio-object-p c) (setq c (eieio-object-class c)))
+ (oset-default c some-slot (intern (concat "moose-" (symbol-name value))))))
(static-method-class-method 'static-method-class-2 'class)
(should (eq (oref-default 'static-method-class-2 some-slot) 'moose-class))
(should (make-instance 'class-a :water 'cho))
(should (make-instance 'class-b)))
-(defmethod class-cn ((_a class-a))
- "Try calling `call-next-method' when there isn't one.
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod class-cn ((_a class-a))
+ "Try calling `call-next-method' when there isn't one.
Argument A is object of type symbol `class-a'."
- (call-next-method))
+ (with-suppressed-warnings ((obsolete call-next-method))
+ (call-next-method)))
-(defmethod no-next-method ((_a class-a) &rest _args)
- "Override signal throwing for variable `class-a'.
+ (defmethod no-next-method ((_a class-a) &rest _args)
+ "Override signal throwing for variable `class-a'.
Argument A is the object of class variable `class-a'."
- 'moose)
+ 'moose))
(ert-deftest eieio-test-08-call-next-method ()
;; Play with call-next-method
(should (eq (class-cn eitest-ab) 'moose)))
-(defmethod no-applicable-method ((_b class-b) _method &rest _args)
- "No need.
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod no-applicable-method ((_b class-b) _method &rest _args)
+ "No need.
Argument B is for booger.
METHOD is the method that was attempting to be called."
- 'moose)
+ 'moose))
(ert-deftest eieio-test-09-no-applicable-method ()
;; Non-existing methods.
(should (eq (class-cn eitest-b) 'moose)))
-(defmethod class-fun ((_a class-a))
- "Fun with class A."
- 'moose)
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod class-fun ((_a class-a))
+ "Fun with class A."
+ 'moose)
-(defmethod class-fun ((_b class-b))
- "Fun with class B."
- (error "Class B fun should not be called")
- )
+ (defmethod class-fun ((_b class-b))
+ "Fun with class B."
+ (error "Class B fun should not be called"))
-(defmethod class-fun-foo ((_b class-b))
- "Foo Fun with class B."
- 'moose)
+ (defmethod class-fun-foo ((_b class-b))
+ "Foo Fun with class B."
+ 'moose)
-(defmethod class-fun2 ((_a class-a))
- "More fun with class A."
- 'moose)
+ (defmethod class-fun2 ((_a class-a))
+ "More fun with class A."
+ 'moose)
-(defmethod class-fun2 ((_b class-b))
- "More fun with class B."
- (error "Class B fun2 should not be called")
- )
+ (defmethod class-fun2 ((_b class-b))
+ "More fun with class B."
+ (error "Class B fun2 should not be called"))
-(defmethod class-fun2 ((_ab class-ab))
- "More fun with class AB."
- (call-next-method))
+ (defmethod class-fun2 ((_ab class-ab))
+ "More fun with class AB."
+ (with-suppressed-warnings ((obsolete call-next-method))
+ (call-next-method)))
-;; How about if B is the only slot?
-(defmethod class-fun3 ((_b class-b))
- "Even More fun with class B."
- 'moose)
+ ;; How about if B is the only slot?
+ (defmethod class-fun3 ((_b class-b))
+ "Even More fun with class B."
+ 'moose)
-(defmethod class-fun3 ((_ab class-ab))
- "Even More fun with class AB."
- (call-next-method))
+ (defmethod class-fun3 ((_ab class-ab))
+ "Even More fun with class AB."
+ (with-suppressed-warnings ((obsolete call-next-method))
+ (call-next-method))))
(ert-deftest eieio-test-10-multiple-inheritance ()
;; play with methods and mi
(defvar class-fun-value-seq '())
-(defmethod class-fun-value :BEFORE ((_a class-a))
- "Return `before', and push `before' in `class-fun-value-seq'."
- (push 'before class-fun-value-seq)
- 'before)
-
-(defmethod class-fun-value :PRIMARY ((_a class-a))
- "Return `primary', and push `primary' in `class-fun-value-seq'."
- (push 'primary class-fun-value-seq)
- 'primary)
-
-(defmethod class-fun-value :AFTER ((_a class-a))
- "Return `after', and push `after' in `class-fun-value-seq'."
- (push 'after class-fun-value-seq)
- 'after)
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod class-fun-value :BEFORE ((_a class-a))
+ "Return `before', and push `before' in `class-fun-value-seq'."
+ (push 'before class-fun-value-seq)
+ 'before)
+
+ (defmethod class-fun-value :PRIMARY ((_a class-a))
+ "Return `primary', and push `primary' in `class-fun-value-seq'."
+ (push 'primary class-fun-value-seq)
+ 'primary)
+
+ (defmethod class-fun-value :AFTER ((_a class-a))
+ "Return `after', and push `after' in `class-fun-value-seq'."
+ (push 'after class-fun-value-seq)
+ 'after))
(ert-deftest eieio-test-12-generic-function-call ()
;; Test value of a generic function call
;;
(ert-deftest eieio-test-13-init-methods ()
- (defmethod initialize-instance ((a class-a) &rest _slots)
- "Initialize the slots of class-a."
- (call-next-method)
- (if (/= (oref a test-tag) 1)
- (error "shared-initialize test failed."))
- (oset a test-tag 2))
-
- (defmethod shared-initialize ((a class-a) &rest _slots)
- "Shared initialize method for class-a."
- (call-next-method)
- (oset a test-tag 1))
-
- (let ((ca (class-a)))
- (should (= (oref ca test-tag) 2))))
+ (with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric)
+ (obsolete call-next-method))
+ (defmethod initialize-instance ((a class-a) &rest _slots)
+ "Initialize the slots of class-a."
+ (call-next-method)
+ (if (/= (oref a test-tag) 1)
+ (error "shared-initialize test failed."))
+ (oset a test-tag 2))
+
+ (defmethod shared-initialize ((a class-a) &rest _slots)
+ "Shared initialize method for class-a."
+ (call-next-method)
+ (oset a test-tag 1))
+
+ (let ((ca (class-a)))
+ (should (= (oref ca test-tag) 2)))))
\f
;;; Perform slot testing
(should (oref eitest-ab amphibian)))
(ert-deftest eieio-test-15-slot-missing ()
-
- (defmethod slot-missing ((_ab class-ab) &rest _foo)
- "If a slot in AB is unbound, return something cool. FOO."
- 'moose)
+ (with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod slot-missing ((_ab class-ab) &rest _foo)
+ "If a slot in AB is unbound, return something cool. FOO."
+ 'moose))
(should (eq (oref eitest-ab ooga-booga) 'moose))
(should-error (oref eitest-a ooga-booga) :type 'invalid-slot-name))
(defclass virtual-slot-class ()
((base-value :initarg :base-value))
"Class has real slot :base-value and simulated slot :derived-value.")
-(defmethod slot-missing ((vsc virtual-slot-class)
- slot-name operation &optional new-value)
- "Simulate virtual slot derived-value."
- (cond
- ((or (eq slot-name :derived-value)
- (eq slot-name 'derived-value))
- (with-slots (base-value) vsc
- (if (eq operation 'oref)
- (+ base-value 1)
- (setq base-value (- new-value 1)))))
- (t (call-next-method))))
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod slot-missing ((vsc virtual-slot-class)
+ slot-name operation &optional new-value)
+ "Simulate virtual slot derived-value."
+ (cond
+ ((or (eq slot-name :derived-value)
+ (eq slot-name 'derived-value))
+ (with-slots (base-value) vsc
+ (if (eq operation 'oref)
+ (+ base-value 1)
+ (setq base-value (- new-value 1)))))
+ (t (with-suppressed-warnings ((obsolete call-next-method))
+ (call-next-method))))))
(ert-deftest eieio-test-17-virtual-slot ()
(setq eitest-vsca (virtual-slot-class :base-value 1))
(should (= (oref eitest-vscb :derived-value) 5)))
(ert-deftest eieio-test-18-slot-unbound ()
-
- (defmethod slot-unbound ((_a class-a) &rest _foo)
- "If a slot in A is unbound, ignore FOO."
- 'moose)
-
- (should (eq (oref eitest-a water) 'moose))
-
- ;; Check if oset of unbound works
- (oset eitest-a water 'moose)
- (should (eq (oref eitest-a water) 'moose))
-
- ;; oref/oref-default comparison
- (should-not (eq (oref eitest-a water) (oref-default eitest-a water)))
-
- ;; oset-default -> oref/oref-default comparison
- (oset-default (eieio-object-class eitest-a) water 'moose)
- (should (eq (oref eitest-a water) (oref-default eitest-a water)))
-
- ;; 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) water) 'penguin))
-
- ;; Revert the above
- (defmethod slot-unbound ((_a class-a) &rest _foo)
- "If a slot in A is unbound, ignore FOO."
- ;; Disable the old slot-unbound so we can run this test
- ;; more than once
- (call-next-method)))
+ (with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod slot-unbound ((_a class-a) &rest _foo)
+ "If a slot in A is unbound, ignore FOO."
+ 'moose)
+
+ (should (eq (oref eitest-a water) 'moose))
+
+ ;; Check if oset of unbound works
+ (oset eitest-a water 'moose)
+ (should (eq (oref eitest-a water) 'moose))
+
+ ;; oref/oref-default comparison
+ (should-not (eq (oref eitest-a water) (oref-default eitest-a water)))
+
+ ;; oset-default -> oref/oref-default comparison
+ (oset-default (eieio-object-class eitest-a) water 'moose)
+ (should (eq (oref eitest-a water) (oref-default eitest-a water)))
+
+ ;; 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) water) 'penguin))
+
+ ;; Revert the above
+ (defmethod slot-unbound ((_a class-a) &rest _foo)
+ "If a slot in A is unbound, ignore FOO."
+ ;; Disable the old slot-unbound so we can run this test
+ ;; more than once
+ (with-suppressed-warnings ((obsolete call-next-method))
+ (call-next-method)))))
(ert-deftest eieio-test-19-slot-type-checking ()
;; Slot type checking
()
"Protection testing baseclass.")
-(defmethod prot0-slot-2 ((s2 prot-0))
- "Try to access slot-2 from this class which doesn't have it.
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod prot0-slot-2 ((s2 prot-0))
+ "Try to access slot-2 from this class which doesn't have it.
The object S2 passed in will be of class prot-1, which does have
the slot. This could be allowed, and currently is in EIEIO.
Needed by the eieio persistent base class."
- (oref s2 slot-2))
+ (oref s2 slot-2)))
(defclass prot-1 (prot-0)
((slot-1 :initarg :slot-1
nil
"A class for testing the :protection option.")
-(defmethod prot1-slot-2 ((s2 prot-1))
- "Try to access slot-2 in S2."
- (oref s2 slot-2))
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod prot1-slot-2 ((s2 prot-1))
+ "Try to access slot-2 in S2."
+ (oref s2 slot-2))
-(defmethod prot1-slot-2 ((s2 prot-2))
- "Try to access slot-2 in S2."
- (oref s2 slot-2))
+ (defmethod prot1-slot-2 ((s2 prot-2))
+ "Try to access slot-2 in S2."
+ (oref s2 slot-2))
-(defmethod prot1-slot-3-only ((s2 prot-1))
- "Try to access slot-3 in S2.
+ (defmethod prot1-slot-3-only ((s2 prot-1))
+ "Try to access slot-3 in S2.
Do not override for `prot-2'."
- (oref s2 slot-3))
+ (oref s2 slot-3))
-(defmethod prot1-slot-3 ((s2 prot-1))
- "Try to access slot-3 in S2."
- (oref s2 slot-3))
+ (defmethod prot1-slot-3 ((s2 prot-1))
+ "Try to access slot-3 in S2."
+ (oref s2 slot-3))
-(defmethod prot1-slot-3 ((s2 prot-2))
- "Try to access slot-3 in S2."
- (oref s2 slot-3))
+ (defmethod prot1-slot-3 ((s2 prot-2))
+ "Try to access slot-3 in S2."
+ (oref s2 slot-3)))
(defvar eitest-p1 nil)
(defvar eitest-p2 nil)
(defclass eieio--testing () ())
-(defmethod constructor :static ((_x eieio--testing) newname &rest _args)
- (list newname 2))
+(with-suppressed-warnings ((obsolete defmethod)
+ (obsolete defgeneric))
+ (defmethod constructor :static ((_x eieio--testing) newname &rest _args)
+ (list newname 2)))
(ert-deftest eieio-test-37-obsolete-name-in-constructor ()
;; FIXME repeated intermittent failures on hydra and elsewhere (bug#24503).
projects / emacs.git / commitdiff