>From 26341ec498e4ffdea1a3c8173c3831c01a745bb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Pierre=20T=C3=A9choueyres?= Date: Fri, 15 Dec 2017 21:42:21 +0100 Subject: [PATCH] Add test for eieio persistence checks * test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el: (hash-equal): New comparaison test for hash-tables. (persist-test-save-and-compare): specialize test for hash-tables. (eieio-test-persist-hash-and-objects): New test. --- .../emacs-lisp/eieio-tests/eieio-test-persist.el | 58 +++++++++++++++++++--- 1 file changed, 50 insertions(+), 8 deletions(-) diff --git a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el index 738711c9c8..cfc51e42a2 100644 --- a/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el +++ b/test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el @@ -1,4 +1,4 @@ -;;; eieio-persist.el --- Tests for eieio-persistent class +;;; eieio-test-persist.el --- Tests for eieio-persistent class ;; Copyright (C) 2011-2017 Free Software Foundation, Inc. @@ -40,6 +40,17 @@ eieio--attribute-to-initarg (car tuple) nil))) +(defun hash-equal (hash1 hash2) + "Compare two hash tables to see whether they are equal." + (and (= (hash-table-count hash1) + (hash-table-count hash2)) + (catch 'flag + (maphash (lambda (x y) + (or (equal (gethash x hash2) y) + (throw 'flag nil))) + hash1) + (throw 'flag t)))) + (defun persist-test-save-and-compare (original) "Compare the object ORIGINAL against the one read fromdisk." @@ -49,8 +60,8 @@ persist-test-save-and-compare (class (eieio-object-class original)) (fromdisk (eieio-persistent-read file class)) (cv (cl--find-class class)) - (slots (eieio--class-slots cv)) - ) + (slots (eieio--class-slots cv))) + (unless (object-of-class-p fromdisk class) (error "Persistent class %S != original class %S" (eieio-object-class fromdisk) @@ -62,17 +73,24 @@ persist-test-save-and-compare (origvalue (eieio-oref original oneslot)) (fromdiskvalue (eieio-oref fromdisk oneslot)) (initarg-p (eieio--attribute-to-initarg - (cl--find-class class) oneslot)) - ) + (cl--find-class class) oneslot))) (if initarg-p - (unless (equal origvalue fromdiskvalue) + (unless + (cond ((and (hash-table-p origvalue) (hash-table-p fromdiskvalue)) + (hash-equal origvalue fromdiskvalue)) + (t (equal origvalue fromdiskvalue))) (error "Slot %S Original Val %S != Persistent Val %S" oneslot origvalue fromdiskvalue)) ;; Else !initarg-p - (unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue) + (let ((origval (cl--slot-descriptor-initform slot)) + (diskval fromdiskvalue)) + (unless + (cond ((and (hash-table-p origval) (hash-table-p diskval)) + (hash-equal origval diskval)) + (t (equal origval diskval))) (error "Slot %S Persistent Val %S != Default Value %S" - oneslot fromdiskvalue (cl--slot-descriptor-initform slot)))) + oneslot diskval origvalue)))) )))) ;;; Simple Case @@ -238,4 +256,28 @@ persistent-with-objs-list-slot (persist-test-save-and-compare persist-wols) (delete-file (oref persist-wols file)))) +(defclass person () + ((name :type string :initarg :name))) + +(defclass classy (eieio-persistent) + ((teacher + :type person + :initarg :teacher) + (students + :initarg :students :initform (make-hash-table :test 'equal)))) + +;;; Slot with a hash-table another with an non persistent Object +;; +;; see bug#29220 +(ert-deftest eieio-test-persist-hash-and-objects () + (let* ((jane (make-instance 'person :name "Jane")) + (bob (make-instance 'person :name "Bob")) + (class (make-instance 'classy + :teacher jane + :file (concat default-directory "classy-" emacs-version ".eieio")))) + (puthash "Bob" bob (slot-value class 'students)) + (persist-test-save-and-compare class) + (delete-file (oref class file)))) + + ;;; eieio-test-persist.el ends here -- 2.14.3