diff options
author | Andrea Corallo <akrl@sdf.org> | 2020-04-06 18:06:29 +0100 |
---|---|---|
committer | Andrea Corallo <akrl@sdf.org> | 2020-04-06 18:06:29 +0100 |
commit | 4abb8c822ce02cf33712bd2699c5b77a5db49e31 (patch) | |
tree | 7520e3cae0f9a958ae223161034ebee6b5aa9e63 /lisp/emacs-lisp/cl-macs.el | |
parent | 32a079aef290fdc8913c1ce4e8910e63e6ff6dcc (diff) | |
parent | 3dc2f50e5bf9f58aee23fd6c61c02fadc240a377 (diff) | |
download | emacs-4abb8c822ce02cf33712bd2699c5b77a5db49e31.tar.gz emacs-4abb8c822ce02cf33712bd2699c5b77a5db49e31.tar.bz2 emacs-4abb8c822ce02cf33712bd2699c5b77a5db49e31.zip |
Merge remote-tracking branch 'savannah/master' into HEAD
Diffstat (limited to 'lisp/emacs-lisp/cl-macs.el')
-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 |