emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master d48c98c: Don't enforce :protection in EIEIO objects


From: Stefan Monnier
Subject: [Emacs-diffs] master d48c98c: Don't enforce :protection in EIEIO objects any more
Date: Sat, 17 Jan 2015 04:48:34 +0000

branch: master
commit d48c98cda83d2c74981c61a0b9d9b379c46217f4
Author: Stefan Monnier <address@hidden>
Commit: Stefan Monnier <address@hidden>

    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.
---
 doc/misc/ChangeLog                        |    6 ++-
 doc/misc/eieio.texi                       |    5 ++
 etc/NEWS                                  |    1 +
 lisp/ChangeLog                            |   12 ++++
 lisp/emacs-lisp/eieio-core.el             |  103 ++++++++---------------------
 lisp/emacs-lisp/eieio-generic.el          |   88 +++++++++++-------------
 lisp/emacs-lisp/eieio.el                  |   17 ++---
 test/ChangeLog                            |   15 ++++-
 test/automated/eieio-test-methodinvoke.el |   52 +++++++--------
 test/automated/eieio-tests.el             |   43 +++++++-----
 10 files changed, 159 insertions(+), 183 deletions(-)

diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 5057fb9..2baa13c 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,7 @@
+2015-01-17  Stefan Monnier  <address@hidden>
+
+       * eieio.texi (Slot Options): Document :protection as unsupported.
+
 2015-01-01  Michael Albinus  <address@hidden>
 
        Sync with Tramp 2.2.11.
@@ -24,7 +28,7 @@
 
 2014-12-18  Eric Abrahamsen  <address@hidden>
 
-       * 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.
 
diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi
index 954970d..3f42862 100644
--- a/doc/misc/eieio.texi
+++ b/doc/misc/eieio.texi
@@ -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
diff --git a/etc/NEWS b/etc/NEWS
index cf93b65..be283bb 100644
--- a/etc/NEWS
+++ b/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.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 01de483..2cc878d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,17 @@
 2015-01-17  Stefan Monnier  <address@hidden>
 
+       * 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  <address@hidden>
+
        Improve handling of doc-strings and describe-function for cl-generic.
 
        * help-mode.el (help-function-def): Add optional arg `type'.
diff --git a/lisp/emacs-lisp/eieio-core.el b/lisp/emacs-lisp/eieio-core.el
index e526a41..0747d97 100644
--- a/lisp/emacs-lisp/eieio-core.el
+++ b/lisp/emacs-lisp/eieio-core.el
@@ -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.
diff --git a/lisp/emacs-lisp/eieio-generic.el b/lisp/emacs-lisp/eieio-generic.el
index 4045c03..27a5849 100644
--- a/lisp/emacs-lisp/eieio-generic.el
+++ b/lisp/emacs-lisp/eieio-generic.el
@@ -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.")
diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index 419a78b..392316c 100644
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -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.")
diff --git a/test/ChangeLog b/test/ChangeLog
index c40407f..2f5ff05 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,7 +1,18 @@
 2015-01-17  Stefan Monnier  <address@hidden>
 
-       * 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  <address@hidden>
+
+       * 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.
diff --git a/test/automated/eieio-test-methodinvoke.el 
b/test/automated/eieio-test-methodinvoke.el
index 1c3d9c3..b6d60b8 100644
--- a/test/automated/eieio-test-methodinvoke.el
+++ b/test/automated/eieio-test-methodinvoke.el
@@ -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))
   )
diff --git a/test/automated/eieio-tests.el b/test/automated/eieio-tests.el
index 0b1ff1f..3a32da6 100644
--- a/test/automated/eieio-tests.el
+++ b/test/automated/eieio-tests.el
@@ -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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]