Commit 59e7fe6d authored by Stefan Monnier's avatar Stefan Monnier

* lisp/emacs-lisp/eieio*.el: Fix up warnings and improve compatibility

Fixes: debbugs:19645

* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Add support for `declare'.
(cl--generic-setf-rewrite): Setup the setf expander right away.
(cl-defmethod): Make sure the setf expander is setup before we expand
the body.
(cl-defmethod): Silence byte-compiler warnings.
(cl-generic-define-method): Shuffle code to change return value.
(cl--generic-method-info): New function, extracted from
cl--generic-describe.
(cl--generic-describe): Use it.

* lisp/emacs-lisp/eieio-speedbar.el:
* lisp/emacs-lisp/eieio-datadebug.el:
* lisp/emacs-lisp/eieio-custom.el:
* lisp/emacs-lisp/eieio-base.el: Use cl-defmethod.

* lisp/emacs-lisp/eieio-compat.el (eieio--defmethod): Avoid no-next-method
errors when there's a `before' but no `primary'.
(next-method-p): Return nil rather than signal an error.
(eieio-defgeneric): Remove bogus (fboundp 'method).

* lisp/emacs-lisp/eieio-opt.el: Adapt to cl-generic.
(eieio--specializers-apply-to-class-p):	New function.
(eieio-all-generic-functions): Use it.
(eieio-method-documentation): Use it as well as cl--generic-method-info.
Change format of return value.
(eieio-help-class): Adapt accordingly.

* lisp/emacs-lisp/eieio.el: Use cl-defmethod.
(defclass): Generate cl-defmethod calls; use setf methods for :accessor.
(eieio-object-name-string): Declare as obsolete.

* test/automated/cl-generic-tests.el (setf cl--generic-2): Make sure
the setf can be used already in the body of the method.
parent 41efcf4d
2015-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/eieio.el: Use cl-defmethod.
(defclass): Generate cl-defmethod calls; use setf methods for :accessor.
(eieio-object-name-string): Declare as obsolete.
* emacs-lisp/eieio-opt.el: Adapt to cl-generic.
(eieio--specializers-apply-to-class-p): New function.
(eieio-all-generic-functions): Use it.
(eieio-method-documentation): Use it as well as cl--generic-method-info.
Change format of return value.
(eieio-help-class): Adapt accordingly.
* emacs-lisp/eieio-compat.el (eieio--defmethod): Avoid no-next-method
errors when there's a `before' but no `primary' (bug#19645).
(next-method-p): Return nil rather than signal an error.
(eieio-defgeneric): Remove bogus (fboundp 'method).
* emacs-lisp/eieio-speedbar.el:
* emacs-lisp/eieio-datadebug.el:
* emacs-lisp/eieio-custom.el:
* emacs-lisp/eieio-base.el: Use cl-defmethod.
* emacs-lisp/cl-generic.el (cl-defgeneric): Add support for `declare'.
(cl--generic-setf-rewrite): Setup the setf expander right away.
(cl-defmethod): Make sure the setf expander is setup before we expand
the body.
(cl-defmethod): Silence byte-compiler warnings.
(cl-generic-define-method): Shuffle code to change return value.
(cl--generic-method-info): New function, extracted from
cl--generic-describe.
(cl--generic-describe): Use it.
2015-01-21 Dmitry Gutov <dgutov@yandex.ru>
* progmodes/xref.el (xref--xref-buffer-mode-map): Define before
......
This diff is collapsed.
......@@ -52,7 +52,7 @@ a parent instance. When a slot in the child is referenced, and has
not been set, use values from the parent."
:abstract t)
(defmethod slot-unbound ((object eieio-instance-inheritor)
(cl-defmethod slot-unbound ((object eieio-instance-inheritor)
_class slot-name _fn)
"If a slot OBJECT in this CLASS is unbound, try to inherit, or throw a signal.
SLOT-NAME is the offending slot. FN is the function signaling the error."
......@@ -61,16 +61,16 @@ SLOT-NAME is the offending slot. FN is the function signaling the error."
;; method if the parent instance's slot is unbound.
(eieio-oref (oref object parent-instance) slot-name)
;; Throw the regular signal.
(call-next-method)))
(cl-call-next-method)))
(defmethod clone ((obj eieio-instance-inheritor) &rest _params)
(cl-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 (call-next-method)))
(let ((nobj (cl-call-next-method)))
(oset nobj parent-instance obj)
nobj))
(defmethod eieio-instance-inheritor-slot-boundp ((object eieio-instance-inheritor)
(cl-defmethod eieio-instance-inheritor-slot-boundp ((object eieio-instance-inheritor)
slot)
"Return non-nil if the instance inheritor OBJECT's SLOT is bound.
See `slot-boundp' for details on binding slots.
......@@ -103,7 +103,7 @@ Inheritors from this class must overload `tracking-symbol' which is
a variable symbol used to store a list of all instances."
:abstract t)
(defmethod initialize-instance :AFTER ((this eieio-instance-tracker)
(cl-defmethod initialize-instance :after ((this eieio-instance-tracker)
&rest _slots)
"Make sure THIS is in our master list of this class.
Optional argument SLOTS are the initialization arguments."
......@@ -112,7 +112,7 @@ Optional argument SLOTS are the initialization arguments."
(if (not (memq this (symbol-value sym)))
(set sym (append (symbol-value sym) (list this))))))
(defmethod delete-instance ((this eieio-instance-tracker))
(cl-defmethod delete-instance ((this eieio-instance-tracker))
"Remove THIS from the master list of this class."
(set (oref this tracking-symbol)
(delq this (symbol-value (oref this tracking-symbol)))))
......@@ -140,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 eieio-constructor :STATIC ((class eieio-singleton) &rest _slots)
(cl-defmethod eieio-constructor ((class (subclass 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,
......@@ -149,7 +149,7 @@ only one object ever exists."
;; with class allocated slots or default values.
(let ((old (oref-default class singleton)))
(if (eq old eieio-unbound)
(oset-default class singleton (call-next-method))
(oset-default class singleton (cl-call-next-method))
old)))
......@@ -198,7 +198,7 @@ object. For this reason, only slots which do not have an `:initarg'
specified will not be saved."
:abstract t)
(defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
(cl-defmethod eieio-persistent-save-interactive ((this eieio-persistent) prompt
&optional name)
"Prepare to save THIS. Use in an `interactive' statement.
Query user for file name with PROMPT if THIS does not yet specify
......@@ -417,17 +417,17 @@ If no class is referenced there, then return nil."
;; No match, not a class.
nil)))
(defmethod object-write ((this eieio-persistent) &optional comment)
(cl-defmethod object-write ((this eieio-persistent) &optional comment)
"Write persistent object THIS out to the current stream.
Optional argument COMMENT is a header line comment."
(call-next-method this (or comment (oref this file-header-line))))
(cl-call-next-method this (or comment (oref this file-header-line))))
(defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
(cl-defmethod eieio-persistent-path-relative ((this eieio-persistent) file)
"For object THIS, make absolute file name FILE relative."
(file-relative-name (expand-file-name file)
(file-name-directory (oref this file))))
(defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
(cl-defmethod eieio-persistent-save ((this eieio-persistent) &optional file)
"Save persistent object THIS to disk.
Optional argument FILE overrides the file name specified in the object
instance."
......@@ -474,21 +474,21 @@ instance."
"Object with a name."
:abstract t)
(defmethod eieio-object-name-string ((obj eieio-named))
(cl-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)
(cl-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)
(cl-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))
(nobj (apply #'cl-call-next-method obj params))
(nm (slot-value obj 'object-name)))
(eieio-oset obj 'object-name
(or newname
......
......@@ -190,13 +190,27 @@ Summary:
(if split (cdr split) docstring))))
(new-docstring (help-add-fundoc-usage doc-only
(cons 'cl-cnm args))))
;; FIXME: ¡Add the new-docstring to those closures!
;; FIXME: ¡Add new-docstring to those closures!
(lambda (cnm &rest args)
(cl-letf (((symbol-function 'call-next-method) cnm)
((symbol-function 'next-method-p)
(lambda () (cl--generic-isnot-nnm-p cnm))))
(apply code args))))
code))))
code))
;; The old EIEIO code did not signal an error when there are methods
;; applicable but only of the before/after kind. So if we add a :before
;; or :after, make sure there's a matching dummy primary.
(when (and (memq kind '(:before :after))
(not (assoc (cons (mapcar (lambda (arg)
(if (consp arg) (nth 1 arg) t))
specializers)
:primary)
(cl--generic-method-table (cl--generic method)))))
(cl-generic-define-method method () specializers t
(lambda (cnm &rest args)
(if (cl--generic-isnot-nnm-p cnm)
(apply cnm args)))))
method))
;; Compatibility with code which tries to catch `no-method-definition' errors.
(push 'no-method-definition (get 'cl-no-applicable-method 'error-conditions))
......@@ -212,7 +226,12 @@ Summary:
(apply #'cl-no-applicable-method method object args))
(define-obsolete-function-alias 'call-next-method 'cl-call-next-method "25.1")
(define-obsolete-function-alias 'next-method-p 'cl-next-method-p "25.1")
(defun next-method-p ()
(declare (obsolete cl-next-method-p "25.1"))
;; EIEIO's `next-method-p' just returned nil when called in an
;; invalid context.
(message "next-method-p called outside of a primary or around method")
nil)
;;;###autoload
(defun eieio-defmethod (method args)
......@@ -225,11 +244,9 @@ Summary:
(defun eieio-defgeneric (method doc-string)
"Obsolete work part of an old version of the `defgeneric' macro."
(declare (obsolete cl-defgeneric "24.1"))
;; Don't do this over and over.
(unless (fboundp 'method)
(eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
;; Return the method
'method))
(eval `(defgeneric ,method (x) ,@(if doc-string `(,doc-string))))
;; Return the method
'method)
;;;###autoload
(defun eieio-defclass (cname superclasses slots options)
......
......@@ -322,7 +322,7 @@ Optional argument IGNORE is an extraneous parameter."
;; This is the same object we had before.
obj))
(defmethod eieio-done-customizing ((_obj eieio-default-superclass))
(cl-defmethod eieio-done-customizing ((_obj eieio-default-superclass))
"When applying change to a widget, call this method.
This method is called by the default widget-edit commands.
User made commands should also call this method when applying changes.
......@@ -345,7 +345,7 @@ Optional argument GROUP is the sub-group of slots to display."
"Major mode for customizing EIEIO objects.
\\{eieio-custom-mode-map}")
(defmethod eieio-customize-object ((obj eieio-default-superclass)
(cl-defmethod eieio-customize-object ((obj eieio-default-superclass)
&optional group)
"Customize OBJ in a specialized custom buffer.
To override call the `eieio-custom-widget-insert' to just insert the
......@@ -386,7 +386,7 @@ These groups are specified with the `:group' slot flag."
(make-local-variable 'eieio-cog)
(setq eieio-cog g)))
(defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
(cl-defmethod eieio-custom-object-apply-reset ((_obj eieio-default-superclass))
"Insert an Apply and Reset button into the object editor.
Argument OBJ is the object being customized."
(widget-create 'push-button
......@@ -417,7 +417,7 @@ Argument OBJ is the object being customized."
(bury-buffer))
"Cancel"))
(defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
(cl-defmethod eieio-custom-widget-insert ((obj eieio-default-superclass)
&rest flags)
"Insert the widget used for editing object OBJ in the current buffer.
Arguments FLAGS are widget compatible flags.
......@@ -446,7 +446,7 @@ Must return the created widget."
;; These functions provide the ability to create dynamic menus to
;; customize specific sections of an object. They do not hook directly
;; into a filter, but can be used to create easymenu vectors.
(defmethod eieio-customize-object-group ((obj eieio-default-superclass))
(cl-defmethod eieio-customize-object-group ((obj eieio-default-superclass))
"Create a list of vectors for customizing sections of OBJ."
(mapcar (lambda (group)
(vector (concat "Group " (symbol-name group))
......@@ -457,7 +457,7 @@ Must return the created widget."
(defvar eieio-read-custom-group-history nil
"History for the custom group reader.")
(defmethod eieio-read-customization-group ((obj eieio-default-superclass))
(cl-defmethod eieio-read-customization-group ((obj eieio-default-superclass))
"Do a completing read on the name of a customization group in OBJ.
Return the symbol for the group, or nil"
(let ((g (eieio--class-option (eieio--object-class-object obj)
......
......@@ -79,7 +79,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
;;
;; Each object should have an opportunity to show stuff about itself.
(defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
(cl-defmethod data-debug/eieio-insert-slots ((obj eieio-default-superclass)
prefix)
"Insert the slots of OBJ into the current DDEBUG buffer."
(let ((inhibit-read-only t))
......@@ -124,7 +124,7 @@ PREBUTTONTEXT is some text between PREFIX and the object button."
;;
;; A generic function to run DDEBUG on an object and popup a new buffer.
;;
(defmethod data-debug-show ((obj eieio-default-superclass))
(cl-defmethod data-debug-show ((obj eieio-default-superclass))
"Run ddebug against any EIEIO object OBJ."
(data-debug-new-buffer (format "*%s DDEBUG*" (eieio-object-name obj)))
(data-debug-insert-object-slots obj "]"))
......
......@@ -122,29 +122,18 @@ If CLASS is actually an object, then also display current values of that object.
;; Describe all the slots in this class.
(eieio-help-class-slots class)
;; Describe all the methods specific to this class.
(let ((methods (eieio-all-generic-functions class))
(type [":STATIC" ":BEFORE" ":PRIMARY" ":AFTER"])
counter doc)
(when methods
(let ((generics (eieio-all-generic-functions class)))
(when generics
(insert (propertize "Specialized Methods:\n\n" 'face 'bold))
(while methods
(setq doc (eieio-method-documentation (car methods) class))
(insert "`")
(help-insert-xref-button (symbol-name (car methods))
'help-function (car methods))
(insert "'")
(if (not doc)
(insert " Undocumented")
(setq counter 0)
(dolist (cur doc)
(when cur
(insert " " (aref type counter) " "
(prin1-to-string (car cur) (current-buffer))
"\n"
(or (cdr cur) "")))
(setq counter (1+ counter))))
(insert "\n\n")
(setq methods (cdr methods))))))
(dolist (generic generics)
(insert "`")
(help-insert-xref-button (symbol-name generic) 'help-function generic)
(insert "'")
(pcase-dolist (`(,qualifier ,args ,doc)
(eieio-method-documentation generic class))
(insert (format " %S %S\n" qualifier args)
(or doc "")))
(insert "\n\n")))))
(defun eieio-help-class-slots (class)
"Print help description for the slots in CLASS.
......@@ -311,6 +300,20 @@ are not abstract."
(eieio-help-class ctr))
))))
(defun eieio--specializers-apply-to-class-p (specializers class)
"Return non-nil if a method with SPECIALIZERS applies to CLASS."
(let ((applies nil))
(dolist (specializer specializers)
(if (eq 'subclass (car-safe specializer))
(setq specializer (nth 1 specializer)))
;; Don't include the methods that are "too generic", such as those
;; applying to `eieio-default-superclass'.
(and (not (memq specializer '(t eieio-default-superclass)))
(class-p specializer)
(child-of-class-p class specializer)
(setq applies t)))
applies))
(defun eieio-all-generic-functions (&optional class)
"Return a list of all generic functions.
Optional CLASS argument returns only those functions that contain
......@@ -318,53 +321,31 @@ methods for CLASS."
(let ((l nil))
(mapatoms
(lambda (symbol)
(let ((tree (get symbol 'eieio-method-hashtable)))
(when tree
;; A symbol might be interned for that class in one of
;; these three slots in the method-obarray.
(if (or (not class)
(car (gethash class (aref tree 0)))
(car (gethash class (aref tree 1)))
(car (gethash class (aref tree 2))))
(setq l (cons symbol l)))))))
(let ((generic (and (fboundp symbol) (cl--generic symbol))))
(and generic
(catch 'found
(if (null class) (throw 'found t))
(pcase-dolist (`((,specializers . ,_qualifier) . ,_)
(cl--generic-method-table generic))
(if (eieio--specializers-apply-to-class-p
specializers class)
(throw 'found t))))
(push symbol l)))))
l))
(defun eieio-method-documentation (generic class)
"Return a list of the specific documentation of GENERIC for CLASS.
If there is not an explicit method for CLASS in GENERIC, or if that
function has no documentation, then return nil."
(let ((tree (get generic 'eieio-method-hashtable)))
(when tree
;; A symbol might be interned for that class in one of
;; these three slots in the method-hashtable.
;; FIXME: Where do these 0/1/2 come from? Isn't 0 for :static,
;; 1 for before, and 2 for primary (and 3 for after)?
(let ((before (car (gethash class (aref tree 0))))
(primary (car (gethash class (aref tree 1))))
(after (car (gethash class (aref tree 2)))))
(if (not (or before primary after))
nil
(list (if before
(cons (help-function-arglist before)
(documentation before))
nil)
(if primary
(cons (help-function-arglist primary)
(documentation primary))
nil)
(if after
(cons (help-function-arglist after)
(documentation after))
nil)))))))
(defvar eieio-read-generic nil
"History of the `eieio-read-generic' prompt.")
(defun eieio-read-generic (prompt &optional historyvar)
"Read a generic function from the minibuffer with PROMPT.
Optional argument HISTORYVAR is the variable to use as history."
(intern (completing-read prompt obarray #'generic-p
t nil (or historyvar 'eieio-read-generic))))
"Return info for all methods of GENERIC applicable to CLASS.
The value returned is a list of elements of the form
\(QUALIFIER ARGS DOC)."
(let ((generic (cl--generic generic))
(docs ()))
(when generic
(dolist (method (cl--generic-method-table generic))
(pcase-let ((`((,specializers . ,_qualifier) . ,_) method))
(when (eieio--specializers-apply-to-class-p
specializers class)
(push (cl--generic-method-info method) docs)))))
docs))
;;; METHOD STATS
;;
......
......@@ -196,19 +196,19 @@ that path."
;; when no other methods are found, allowing multiple inheritance to work
;; reliably with eieio-speedbar.
(defmethod eieio-speedbar-description (object)
(cl-defmethod eieio-speedbar-description (object)
"Return a string describing OBJECT."
(eieio-object-name-string object))
(defmethod eieio-speedbar-derive-line-path (_object)
(cl-defmethod eieio-speedbar-derive-line-path (_object)
"Return the path which OBJECT has something to do with."
nil)
(defmethod eieio-speedbar-object-buttonname (object)
(cl-defmethod eieio-speedbar-object-buttonname (object)
"Return a string to use as a speedbar button for OBJECT."
(eieio-object-name-string object))
(defmethod eieio-speedbar-make-tag-line (object depth)
(cl-defmethod eieio-speedbar-make-tag-line (object depth)
"Insert a tag line into speedbar at point for OBJECT.
By default, all objects appear as simple TAGS with no need to inherit from
the special `eieio-speedbar' classes. Child classes should redefine this
......@@ -221,7 +221,7 @@ Argument DEPTH is the depth at which the tag line is inserted."
'speedbar-tag-face
depth))
(defmethod eieio-speedbar-handle-click (object)
(cl-defmethod eieio-speedbar-handle-click (object)
"Handle a click action on OBJECT in speedbar.
Any object can be represented as a tag in SPEEDBAR without special
attributes. These default objects will be pulled up in a custom
......@@ -285,7 +285,7 @@ Add one of the child classes to this class to the parent list of a class."
;;; Methods to eieio-speedbar-* which do not need to be overridden
;;
(defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
(cl-defmethod eieio-speedbar-make-tag-line ((object eieio-speedbar)
depth)
"Insert a tag line into speedbar at point for OBJECT.
All objects a child of symbol `eieio-speedbar' can be created from
......@@ -321,12 +321,12 @@ Argument DEPTH is the depth at which the tag line is inserted."
(if exp
(eieio-speedbar-expand object (1+ depth))))))
(defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth)
(cl-defmethod eieio-speedbar-child-make-tag-lines ((object eieio-speedbar) _depth)
"Base method for creating tag lines for non-object children."
(error "You must implement `eieio-speedbar-child-make-tag-lines' for %s"
(eieio-object-name object)))
(defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
(cl-defmethod eieio-speedbar-expand ((object eieio-speedbar) depth)
"Expand OBJECT at indentation DEPTH.
Inserts a list of new tag lines representing expanded elements within
OBJECT."
......@@ -362,7 +362,7 @@ TOKEN is the object. INDENT is the current indentation level."
(t (error "Ooops... not sure what to do")))
(speedbar-center-buffer-smartly))
(defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
(cl-defmethod eieio-speedbar-child-description ((obj eieio-speedbar))
"Return a description for a child of OBJ which is not an object."
(error "You must implement `eieio-speedbar-child-description' for %s"
(eieio-object-name obj)))
......@@ -412,7 +412,7 @@ Optional DEPTH is the depth we start at."
;;; Methods to the eieio-speedbar-* classes which need to be overridden.
;;
(defmethod eieio-speedbar-object-children ((_object eieio-speedbar))
(cl-defmethod eieio-speedbar-object-children ((_object eieio-speedbar))
"Return a list of children to be displayed in speedbar.
If the return value is a list of OBJECTs, then those objects are
queried for details. If the return list is made of strings,
......
This diff is collapsed.
2015-01-21 Stefan Monnier <monnier@iro.umontreal.ca>
* automated/cl-generic-tests.el (setf cl--generic-2): Make sure
the setf can be used already in the body of the method.
2015-01-20 Jorgen Schaefer <contact@jorgenschaefer.de>
* automated/package-test.el (package-test-install-prioritized):
Removed test due to unreproducable failures.
Remove test due to unreproducable failures.
2015-01-20 Michal Nazarewicz <mina86@mina86.com>
......@@ -15,8 +20,8 @@
A new helper function for testing `tildify-double-space-undos'
behaviour in the `tildify-space' function.
(tildify-space-undo-test-html, tildify-space-undo-test-html-nbsp)
(tildify-space-undo-test-xml, tildify-space-undo-test-tex): New
tests for `tildify-doule-space-undos' behaviour.
(tildify-space-undo-test-xml, tildify-space-undo-test-tex):
New tests for `tildify-doule-space-undos' behaviour.
* automated/tildify-tests.el (tildify-space-test--test):
A new helper function for testing `tildify-space' function.
......
......@@ -73,6 +73,11 @@
(should (equal (cl--generic-1 (make-cl-generic-struct-child11) nil)
'("child11" "around""child1" "parent" a))))
;; I don't know how to put this inside an `ert-test'. This tests that `setf'
;; can be used directly inside the body of the setf method.
(cl-defmethod (setf cl--generic-2) (v (y integer) z)
(setf (cl--generic-2 (nth y z) z) v))
(ert-deftest cl-generic-test-03-setf ()
(cl-defmethod (setf cl--generic-1) (v (y t) z) (list v y z))
(cl-defmethod (setf cl--generic-1) (v (_y (eql 4)) z) (list v "four" z))
......
......@@ -292,6 +292,7 @@
(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")
......@@ -302,6 +303,7 @@
(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")
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment