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'.

1 files changed, 36 insertions, 0 deletions

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: