diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2020-04-05 09:54:53 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2020-04-05 09:54:53 -0400 |
commit | a32c55bd9f3aa06b74adc9630b55689972c52356 (patch) | |
tree | 78378ef0ea959035f7661c61b819e2b68f681521 /lisp/emacs-lisp | |
parent | 4ed39549e3f9dbfeb2aea0e2674a7701dbc0e5ea (diff) | |
download | emacs-a32c55bd9f3aa06b74adc9630b55689972c52356.tar.gz emacs-a32c55bd9f3aa06b74adc9630b55689972c52356.tar.bz2 emacs-a32c55bd9f3aa06b74adc9630b55689972c52356.zip |
* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Avoid known cl-defsubst breakage
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 7f5d197b532..45a308ebcac 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2970,14 +2970,26 @@ Supported keywords for slots are: (pcase-dolist (`(,cname ,args ,doc) constrs) (let* ((anames (cl--arglist-args args)) (make (cl-mapcar (function (lambda (s d) (if (memq s anames) s d))) - slots defaults))) - (push `(,cldefsym ,cname + slots defaults)) + ;; `cl-defsubst' is fundamentally broken: it substitutes + ;; its arguments into the body's `sexp' much too naively + ;; when inlinling, which results in various problems. + ;; For example it generates broken code if your + ;; argument's name happens to be the same as some + ;; function used within the body. + ;; E.g. (cl-defsubst sm-foo (list) (list list)) + ;; will expand `(sm-foo 1)' to `(1 1)' rather than to `(list t)'! + ;; Try to catch this known case! + (con-fun (or type #'record)) + (unsafe-cl-defsubst + (or (memq con-fun args) (assq con-fun args)))) + (push `(,(if unsafe-cl-defsubst 'cl-defun cldefsym) ,cname (&cl-defs (nil ,@descs) ,@args) ,(if (stringp doc) doc (format "Constructor for objects of type `%s'." name)) ,@(if (cl--safe-expr-p `(progn ,@(mapcar #'cl-second descs))) '((declare (side-effect-free t)))) - (,(or type #'record) ,@make)) + (,con-fun ,@make)) forms))) (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) ;; Don't bother adding to cl-custom-print-functions since it's not used |