aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2015-01-15 08:38:00 -0500
committerStefan Monnier2015-01-16 17:48:59 -0500
commit9d940c667ab1dadc9d25a88cc2af1594b6c1bb49 (patch)
treeb50713180efcb5d3c041909db3e48598740a051f
parent78e6ccc4a5006272b14f352e459a6d3bf52ed07b (diff)
downloademacs-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/ChangeLog3
-rw-r--r--lisp/emacs-lisp/cl-generic.el7
-rw-r--r--test/automated/cl-generic-tests.el13
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
392015-01-15 Stefan Monnier <monnier@iro.umontreal.ca> 392015-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