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'.
This commit is contained in:
parent
b6738682ae
commit
2c68192c6b
6 changed files with 84 additions and 3 deletions
|
@ -423,6 +423,7 @@ Sequences, Arrays, and Vectors
|
|||
Records
|
||||
|
||||
* Record Functions:: Functions for records.
|
||||
* Backward Compatibility:: Compatibility for cl-defstruct.
|
||||
|
||||
Hash Tables
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue