diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2017-03-24 09:21:52 -0400 |
---|---|---|
committer | Lars Brinkhoff <lars@nocrew.org> | 2017-04-04 08:23:46 +0200 |
commit | 2c68192c6b029bb839193c81cf2a16dad26305c6 (patch) | |
tree | ab9f36acd0dfc67d261d584949bd22fc8c262cd1 | |
parent | b6738682ae16c71132c95cd87d48daf598fe89a9 (diff) | |
download | emacs-2c68192c6b029bb839193c81cf2a16dad26305c6.tar.gz |
Backward compatibility with pre-existing struct instances.
* lisp/emacs-lisp/cl-lib.el (cl--old-struct-type-of): New function.
(cl-old-struct-compat-mode): New minor mode.
* lisp/emacs-lisp/cl-macs.el (cl-defstruct): Pass `record' to
cl-struct-define to signal use of record objects.
* lisp/emacs-lisp/cl-preloaded.el (cl--struct-get-class,
cl-struct-define): Enable legacy defstruct compatibility.
* test/lisp/emacs-lisp/cl-lib-tests.el (cl-lib-old-struct,
old-struct): New tests.
* doc/lispref/elisp.texi, doc/lispref/records.texi: Document
`old-struct-compat'.
-rw-r--r-- | doc/lispref/elisp.texi | 1 | ||||
-rw-r--r-- | doc/lispref/records.texi | 17 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-lib.el | 36 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 4 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-preloaded.el | 6 | ||||
-rw-r--r-- | test/lisp/emacs-lisp/cl-lib-tests.el | 23 |
6 files changed, 84 insertions, 3 deletions
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 0f7efb6f187..3a348aae98e 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -423,6 +423,7 @@ Sequences, Arrays, and Vectors Records * Record Functions:: Functions for records. +* Backward Compatibility:: Compatibility for cl-defstruct. Hash Tables diff --git a/doc/lispref/records.texi b/doc/lispref/records.texi index 822fd2bf36e..9a5d900cfc9 100644 --- a/doc/lispref/records.texi +++ b/doc/lispref/records.texi @@ -26,7 +26,8 @@ evaluating it is the same record. This does not evaluate or even examine the slots. @xref{Self-Evaluating Forms}. @menu -* Record Functions:: Functions for records. +* Record Functions:: Functions for records. +* Backward Compatibility:: Compatibility for cl-defstruct. @end menu @node Record Functions @@ -98,3 +99,17 @@ the copied record, are also visible in the original record. @end group @end example @end defun + +@node Backward Compatibility +@section Backward Compatibility + + Code compiled with older versions of @code{cl-defstruct} that +doesn't use records may run into problems when used in a new Emacs. +To alleviate this, Emacs detects when an old @code{cl-defstruct} is +used, and enables a mode in which @code{type-of} handles old struct +objects as if they were records. + +@defun cl-old-struct-compat-mode arg +If @var{arg} is positive, enable backward compatibility with old-style +structs. +@end defun diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 8c4455a3dad..1f8615fad3e 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -639,6 +639,42 @@ If ALIST is non-nil, the new pairs are prepended to it." (require 'cl-macs) (require 'cl-seq)) +(defun cl--old-struct-type-of (orig-fun object) + (or (and (vectorp object) + (let ((tag (aref object 0))) + (when (and (symbolp tag) + (string-prefix-p "cl-struct-" (symbol-name tag))) + (unless (eq (symbol-function tag) + :quick-object-witness-check) + ;; Old-style old-style struct: + ;; Convert to new-style old-style struct! + (let* ((type (intern (substring (symbol-name tag) + (length "cl-struct-")))) + (class (cl--struct-get-class type))) + ;; If the `cl-defstruct' was recompiled after the code + ;; which constructed `object', `cl--struct-get-class' may + ;; not have called `cl-struct-define' and setup the tag + ;; symbol for us. + (unless (eq (symbol-function tag) + :quick-object-witness-check) + (set tag class) + (fset tag :quick-object-witness-check)))) + (cl--class-name (symbol-value tag))))) + (funcall orig-fun object))) + +;;;###autoload +(define-minor-mode cl-old-struct-compat-mode + "Enable backward compatibility with old-style structs. +This can be needed when using code byte-compiled using the old +macro-expansion of `cl-defstruct' that used vectors objects instead +of record objects." + :global t + (cond + (cl-old-struct-compat-mode + (advice-add 'type-of :around #'cl--old-struct-type-of)) + (t + (advice-remove 'type-of #'cl--old-struct-type-of)))) + ;; Local variables: ;; byte-compile-dynamic: t ;; End: diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c282938a9bf..25c9f999920 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2847,8 +2847,8 @@ non-nil value, that slot cannot be set via `setf'. ;; struct as a parent. (eval-and-compile (cl-struct-define ',name ,docstring ',include-name - ',type ,(eq named t) ',descs ',tag-symbol ',tag - ',print-auto)) + ',(or type 'record) ,(eq named t) ',descs + ',tag-symbol ',tag ',print-auto)) ',name))) ;;; Add cl-struct support to pcase diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 7432dd4978d..ab6354de7cd 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -110,6 +110,12 @@ ;;;###autoload (defun cl-struct-define (name docstring parent type named slots children-sym tag print) + (unless type + ;; Legacy defstruct, using tagged vectors. Enable backward compatibility. + (cl-old-struct-compat-mode 1)) + (if (eq type 'record) + ;; Defstruct using record objects. + (setq type nil)) (cl-assert (or type (not named))) (if (boundp children-sym) (add-to-list children-sym tag) diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el b/test/lisp/emacs-lisp/cl-lib-tests.el index 6b930a8d17a..564ddab67db 100644 --- a/test/lisp/emacs-lisp/cl-lib-tests.el +++ b/test/lisp/emacs-lisp/cl-lib-tests.el @@ -526,4 +526,27 @@ (should (eq (type-of x) 'foo)) (should (eql (foo-x x) 42)))) +(ert-deftest old-struct () + (cl-defstruct foo x) + (let ((x [cl-struct-foo]) + (saved cl-old-struct-compat-mode)) + (cl-old-struct-compat-mode -1) + (should (eq (type-of x) 'vector)) + + (cl-old-struct-compat-mode 1) + (let ((cl-struct-foo (cl--struct-get-class 'foo))) + (setf (symbol-function 'cl-struct-foo) :quick-object-witness-check) + (should (eq (type-of x) 'foo)) + (should (eq (type-of [foo]) 'vector))) + + (cl-old-struct-compat-mode (if saved 1 -1)))) + +(ert-deftest cl-lib-old-struct () + (let ((saved cl-old-struct-compat-mode)) + (cl-old-struct-compat-mode -1) + (cl-struct-define 'foo "" 'cl-structure-object nil nil nil + 'cl-struct-foo-tags 'cl-struct-foo t) + (should cl-old-struct-compat-mode) + (cl-old-struct-compat-mode (if saved 1 -1)))) + ;;; cl-lib.el ends here |