diff options
| author | Philipp Stephani | 2020-08-02 18:05:36 +0200 |
|---|---|---|
| committer | Philipp Stephani | 2020-08-02 18:05:36 +0200 |
| commit | 3e0c3479b24e1978d30bbcc00faac7bdd6bdd170 (patch) | |
| tree | 6c986cb3485d84bf9eb638d5b5295c6b5a0ce8c0 | |
| parent | 0a65e060207def5d31fb7d96b8d3bb1441fd13c9 (diff) | |
| download | emacs-3e0c3479b24e1978d30bbcc00faac7bdd6bdd170.tar.gz emacs-3e0c3479b24e1978d30bbcc00faac7bdd6bdd170.zip | |
Add a workaround for Bug#42672
* lisp/emacs-lisp/cl-generic.el (cl-defgeneric): Work around Bug#42672
by uniquifying inline method names.
* test/lisp/emacs-lisp/cl-generic-tests.el
(cl-defgeneric/edebug/method): New regression test.
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 11 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-generic-tests.el | 36 |
2 files changed, 46 insertions, 1 deletions
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index c67681b0960..640eb6b06d4 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el | |||
| @@ -211,7 +211,16 @@ DEFAULT-BODY, if present, is used as the body of a default method. | |||
| 211 | [&rest [&or | 211 | [&rest [&or |
| 212 | ("declare" &rest sexp) | 212 | ("declare" &rest sexp) |
| 213 | (":argument-precedence-order" &rest sexp) | 213 | (":argument-precedence-order" &rest sexp) |
| 214 | (&define ":method" [&rest atom] | 214 | (&define ":method" |
| 215 | ;; FIXME: The `:unique' | ||
| 216 | ;; construct works around | ||
| 217 | ;; Bug#42672. We'd rather want | ||
| 218 | ;; names like those generated by | ||
| 219 | ;; `cl-defmethod', but that | ||
| 220 | ;; requires larger changes to | ||
| 221 | ;; Edebug. | ||
| 222 | :unique "cl-generic-:method@" | ||
| 223 | [&rest atom] | ||
| 215 | cl-generic-method-args lambda-doc | 224 | cl-generic-method-args lambda-doc |
| 216 | def-body)]] | 225 | def-body)]] |
| 217 | def-body))) | 226 | def-body))) |
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el b/test/lisp/emacs-lisp/cl-generic-tests.el index 51c9884ddc8..fc39e349523 100644 --- a/test/lisp/emacs-lisp/cl-generic-tests.el +++ b/test/lisp/emacs-lisp/cl-generic-tests.el | |||
| @@ -24,6 +24,7 @@ | |||
| 24 | ;;; Code: | 24 | ;;; Code: |
| 25 | 25 | ||
| 26 | (require 'cl-generic) | 26 | (require 'cl-generic) |
| 27 | (require 'edebug) | ||
| 27 | 28 | ||
| 28 | ;; Don't indirectly require `cl-lib' at run-time. | 29 | ;; Don't indirectly require `cl-lib' at run-time. |
| 29 | (eval-when-compile (require 'ert)) | 30 | (eval-when-compile (require 'ert)) |
| @@ -249,5 +250,40 @@ | |||
| 249 | (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic)) | 250 | (should-not (cl--generic-method-files 'cl-generic-tests--undefined-generic)) |
| 250 | (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods))) | 251 | (should-not (cl--generic-method-files 'cl-generic-tests--generic-without-methods))) |
| 251 | 252 | ||
| 253 | (ert-deftest cl-defgeneric/edebug/method () | ||
| 254 | "Check that `:method' forms in `cl-defgeneric' create unique | ||
| 255 | Edebug symbols (Bug#42672)." | ||
| 256 | (with-temp-buffer | ||
| 257 | (dolist (form '((cl-defgeneric cl-defgeneric/edebug/method/1 (_) | ||
| 258 | (:method ((_ number)) 1) | ||
| 259 | (:method ((_ string)) 2)) | ||
| 260 | (cl-defgeneric cl-defgeneric/edebug/method/2 (_) | ||
| 261 | (:method ((_ number)) 3)))) | ||
| 262 | (print form (current-buffer))) | ||
| 263 | (let* ((edebug-all-defs t) | ||
| 264 | (edebug-initial-mode 'Go-nonstop) | ||
| 265 | (instrumented-names ()) | ||
| 266 | (edebug-new-definition-function | ||
| 267 | (lambda (name) | ||
| 268 | (when (memq name instrumented-names) | ||
| 269 | (error "Duplicate definition of `%s'" name)) | ||
| 270 | (push name instrumented-names) | ||
| 271 | (edebug-new-definition name))) | ||
| 272 | ;; Make generated symbols reproducible. | ||
| 273 | (gensym-counter 10000)) | ||
| 274 | (eval-buffer) | ||
| 275 | (should (equal (reverse instrumented-names) | ||
| 276 | ;; The generic function definitions come after | ||
| 277 | ;; the method definitions because their body ends | ||
| 278 | ;; later. | ||
| 279 | ;; FIXME: We'd rather have names such as | ||
| 280 | ;; `cl-defgeneric/edebug/method/1 ((_ number))', | ||
| 281 | ;; but that requires further changes to Edebug. | ||
| 282 | (list (intern "cl-generic-:method@10000 ((_ number))") | ||
| 283 | (intern "cl-generic-:method@10001 ((_ string))") | ||
| 284 | 'cl-defgeneric/edebug/method/1 | ||
| 285 | (intern "cl-generic-:method@10002 ((_ number))") | ||
| 286 | 'cl-defgeneric/edebug/method/2)))))) | ||
| 287 | |||
| 252 | (provide 'cl-generic-tests) | 288 | (provide 'cl-generic-tests) |
| 253 | ;;; cl-generic-tests.el ends here | 289 | ;;; cl-generic-tests.el ends here |