[Emacs-diffs] scratch/record 06a3465: Remove old-struct-compat in favour of cl-old-struct-compat-mode.

[Lars Brinkhoff]

branch: scratch/record
commit 06a346594ddf35e916cf56b063f8b6dbafcb763f
Author: Lars Brinkhoff <address@hidden>
Commit: Lars Brinkhoff <address@hidden>

    Remove old-struct-compat in favour of cl-old-struct-compat-mode.
    
    Adapt tests.
---
 src/data.c                           | 31 +------------------------------
 test/lisp/emacs-lisp/cl-lib-tests.el | 21 +++++++++++++++++++--
 test/src/data-tests.el               |  8 --------
 3 files changed, 20 insertions(+), 40 deletions(-)

diff --git a/src/data.c b/src/data.c
index 0cb1a90..d16ba9c 100644
--- a/src/data.c
+++ b/src/data.c
@@ -201,29 +201,6 @@ DEFUN ("null", Fnull, Snull, 1, 1, 0,
   return Qnil;
 }
 
-static const char old_struct_prefix[] = "cl-struct-";
-
-static int
-vector_struct_p (Lisp_Object object)
-{
-  if (! old_struct_compat || ASIZE (object) < 1)
-    return false;
-
-  Lisp_Object type = AREF (object, 0);
-  return SYMBOLP (type)
-    && strncmp (SSDATA (SYMBOL_NAME (type)),
-               old_struct_prefix,
-               sizeof old_struct_prefix - 1) == 0;
-}
-
-static Lisp_Object
-type_of_vector (Lisp_Object object)
-{
-  if (vector_struct_p (object))
-    return AREF (object, 0);
-  return Qvector;
-}
-
 DEFUN ("type-of", Ftype_of, Stype_of, 1, 1, 0,
        doc: /* Return a symbol representing the type of OBJECT.
 The symbol returned names the object's basic type;
@@ -266,7 +243,7 @@ for example, (type-of 1) returns `integer'.  */)
     case Lisp_Vectorlike:
       switch (PSEUDOVECTOR_TYPE (XVECTOR (object)))
         {
-        case PVEC_NORMAL_VECTOR: return type_of_vector (object);
+        case PVEC_NORMAL_VECTOR: return Qvector;
         case PVEC_WINDOW_CONFIGURATION: return Qwindow_configuration;
         case PVEC_PROCESS: return Qprocess;
         case PVEC_WINDOW: return Qwindow;
@@ -3902,12 +3879,6 @@ syms_of_data (void)
   Vmost_negative_fixnum = make_number (MOST_NEGATIVE_FIXNUM);
   make_symbol_constant (intern_c_string ("most-negative-fixnum"));
 
-  DEFVAR_BOOL ("old-struct-compat", old_struct_compat,
-              doc: /* Non-nil means try to be compatible with old structs.
-If a vector has a symbol in its first slot, and that symbol has a prefix
-`cl-struct-', `type-of' will return that symbol as the type of the vector.  
*/);
-  old_struct_compat = false;
-
   DEFSYM (Qwatchers, "watchers");
   DEFSYM (Qmakunbound, "makunbound");
   DEFSYM (Qunlet, "unlet");
diff --git a/test/lisp/emacs-lisp/cl-lib-tests.el 
b/test/lisp/emacs-lisp/cl-lib-tests.el
index b66e7ac..8e06945 100644
--- a/test/lisp/emacs-lisp/cl-lib-tests.el
+++ b/test/lisp/emacs-lisp/cl-lib-tests.el
@@ -500,10 +500,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)
+    (setq 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 saved)))
+
 (ert-deftest cl-lib-old-struct ()
-  (let ((old-struct-compat nil))
+  (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 old-struct-compat)))
+    (should cl-old-struct-compat-mode)
+    (cl-old-struct-compat-mode saved)))
 
 ;;; cl-lib.el ends here
diff --git a/test/src/data-tests.el b/test/src/data-tests.el
index f4729dd..67d00a7 100644
--- a/test/src/data-tests.el
+++ b/test/src/data-tests.el
@@ -480,11 +480,3 @@ comparing the subr with a much slower lisp implementation."
       (remove-variable-watcher 'data-tests-lvar collect-watch-data)
       (setq data-tests-lvar 6)
       (should (null watch-data)))))
-
-(ert-deftest old-struct ()
-  (let ((x [cl-struct-foo]))
-    (let ((old-struct-compat nil))
-      (should (eq (type-of x) 'vector)))
-    (let ((old-struct-compat t))
-      (should (eq (type-of x) 'cl-struct-foo))
-      (should (eq (type-of [foo]) 'vector)))))