diff options
| author | Stefan Monnier | 2015-01-15 08:38:00 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2015-01-16 17:48:59 -0500 |
| commit | 9d940c667ab1dadc9d25a88cc2af1594b6c1bb49 (patch) | |
| tree | b50713180efcb5d3c041909db3e48598740a051f | |
| parent | 78e6ccc4a5006272b14f352e459a6d3bf52ed07b (diff) | |
| download | emacs-9d940c667ab1dadc9d25a88cc2af1594b6c1bb49.tar.gz emacs-9d940c667ab1dadc9d25a88cc2af1594b6c1bb49.zip | |
* lisp/emacs-lisp/cl-generic.el (cl--generic-build-combined-method):
Return the value of the primary rather than the after method.
| -rw-r--r-- | lisp/ChangeLog | 3 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 7 | ||||
| -rw-r--r-- | test/automated/cl-generic-tests.el | 13 |
3 files changed, 20 insertions, 3 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 57aaea0f4ce..c6e315e1260 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -38,6 +38,9 @@ | |||
| 38 | 38 | ||
| 39 | 2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca> | 39 | 2015-01-15 Stefan Monnier <monnier@iro.umontreal.ca> |
| 40 | 40 | ||
| 41 | * emacs-lisp/cl-generic.el (cl--generic-build-combined-method): | ||
| 42 | Return the value of the primary rather than the after method. | ||
| 43 | |||
| 41 | * emacs-lisp/eieio-core.el: Provide support for cl-generic. | 44 | * emacs-lisp/eieio-core.el: Provide support for cl-generic. |
| 42 | (eieio--generic-tagcode): New function. | 45 | (eieio--generic-tagcode): New function. |
| 43 | (cl-generic-tagcode-function): Use it. | 46 | (cl-generic-tagcode-function): Use it. |
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 41a419a3c4a..21688bef18a 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el | |||
| @@ -411,9 +411,10 @@ for all those different tags in the method-cache.") | |||
| 411 | (setq fun (lambda (&rest args) | 411 | (setq fun (lambda (&rest args) |
| 412 | (dolist (bf before) | 412 | (dolist (bf before) |
| 413 | (apply bf args)) | 413 | (apply bf args)) |
| 414 | (apply next args) | 414 | (prog1 |
| 415 | (dolist (af after) | 415 | (apply next args) |
| 416 | (apply af args)))))) | 416 | (dolist (af after) |
| 417 | (apply af args))))))) | ||
| 417 | (cl--generic-nest fun (alist-get :around mets-by-qual)))))))) | 418 | (cl--generic-nest fun (alist-get :around mets-by-qual)))))))) |
| 418 | 419 | ||
| 419 | (defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags) | 420 | (defun cl--generic-cache-miss (generic dispatch-arg dispatches-left tags) |
diff --git a/test/automated/cl-generic-tests.el b/test/automated/cl-generic-tests.el index 17bce6a3157..57b17b145e8 100644 --- a/test/automated/cl-generic-tests.el +++ b/test/automated/cl-generic-tests.el | |||
| @@ -129,5 +129,18 @@ | |||
| 129 | (cons "x&y-int" (cl-call-next-method))) | 129 | (cons "x&y-int" (cl-call-next-method))) |
| 130 | (should (equal (cl--generic-1 1 2) '("x&y-int" "y-int" "x-int" 1 2)))) | 130 | (should (equal (cl--generic-1 1 2) '("x&y-int" "y-int" "x-int" 1 2)))) |
| 131 | 131 | ||
| 132 | (ert-deftest cl-generic-test-7-after/before () | ||
| 133 | (let ((log ())) | ||
| 134 | (cl-defgeneric cl--generic-1 (x y)) | ||
| 135 | (cl-defmethod cl--generic-1 ((_x t) y) (cons y log)) | ||
| 136 | (cl-defmethod cl--generic-1 ((_x (eql 4)) _y) | ||
| 137 | (cons "quatre" (cl-call-next-method))) | ||
| 138 | (cl-defmethod cl--generic-1 :after (x _y) | ||
| 139 | (push (list :after x) log)) | ||
| 140 | (cl-defmethod cl--generic-1 :before (x _y) | ||
| 141 | (push (list :before x) log)) | ||
| 142 | (should (equal (cl--generic-1 4 6) '("quatre" 6 (:before 4)))) | ||
| 143 | (should (equal log '((:after 4) (:before 4)))))) | ||
| 144 | |||
| 132 | (provide 'cl-generic-tests) | 145 | (provide 'cl-generic-tests) |
| 133 | ;;; cl-generic-tests.el ends here | 146 | ;;; cl-generic-tests.el ends here |