Subject: bug#29220: 26.0.90; eieio-persistent-read fail to restore saved object.

From: [email-masked] (Pierre Téchoueyres)
Date: Fri, 15 Dec 2017 21:26:06 +0100

Noam Postavsky <[email-masked]> writes:

> tags 29220 fixed
> close 29220 26.1
> quit
> [...]
> Closing.
Sorry but I not certain everything is working as expected.

I'm trying to add another test to the eieio part
(test/lisp/emacs-lisp/eieio-tests/eieio-test-persist.el) but when I did
try the simple receipt which Eric had posted some times ago I end in the
debugger.

#+BEGIN_SRC debugger
Debugger entered--Lisp error: (wrong-type-argument sequencep person)
  mapc(#f(compiled-function (elt) #<bytecode 0x237e645>) person)
  seq-do(#f(compiled-function (elt) #<bytecode 0x237e645>) person)
  seq-some(#f(compiled-function (elt) #<bytecode 0x237e299>) person)
  eieio-persistent-validate/fix-slot-value(#s(eieio--class :name classy :docstring nil :parents (#s(eieio--class :name eieio-persistent :docstring "This special class enables persistence through save files\nUse the `object-save' method to write this object to disk.  The save\nformat is Emacs Lisp code which calls the constructor for the saved\nobject.  For this reason, only slots which do not have an `:initarg'\nspecified will not be saved." :parents nil :slots [#s(cl-slot-descriptor :name file :initform unbound :type string :props ((:documentation . "The save file for this persistent object.\nThis must be a string, and must be specified when the new object is\ninstantiated.")))] :index-table #<hash-table eq 1/65 0x129c671> :children (classy pcache-repository) :initarg-tuples ((:file . file)) :class-slots [#s(cl-slot-descriptor :name do-backups :initform t :type boolean :props ((:documentation . "Saving this object should make backup files.\nSetting to nil will mean no backups are made."))) #s(cl-slot-descriptor :name file-header-line :initform ";; EIEIO PERSISTENT OBJECT" :type string :props ((:documentation . "Header line for the save file.\nThis is used with the `object-write' method."))) #s(cl-slot-descriptor :name extension :initform ".eieio" :type string :props ((:documentation . "Extension of files saved by this object.\nEnables auto-choosing nice file names based on name.")))] :class-allocation-values [t ";; EIEIO PERSISTENT OBJECT" ".eieio"] :default-object-cache #<eieio-persistent eieio-persistent> :options (:custom-groups nil :documentation "This special class enables persistence through save files\nUse the `object-save' method to write this object to disk.  The save\nformat is Emacs Lisp code which calls the constructor for the saved\nobject.  For this reason, only slots which do not have an `:initarg'\nspecified will not be saved." :abstract t))) :slots [#s(cl-slot-descriptor :name file :initform unbound :type string :props ((:documentation . "The save file for this persistent object.\nThis must be a string, and must be specified when the new object is\ninstantiated."))) #s(cl-slot-descriptor :name teacher :initform unbound :type person :props nil) #s(cl-slot-descriptor :name students :initform (make-hash-table) :type t :props nil)] :index-table #<hash-table eq 3/65 0x14d45a5> :children nil :initarg-tuples ((:file . file) (:teacher . teacher) (:students . students)) :class-slots [#s(cl-slot-descriptor :name extension :initform ".eieio" :type string :props ((:documentation . "Extension of files saved by this object.\nEnables auto-choosing nice file names based on name."))) #s(cl-slot-descriptor :name file-header-line :initform ";; EIEIO PERSISTENT OBJECT" :type string :props ((:documentation . "Header line for the save file.\nThis is used with the `object-write' method."))) #s(cl-slot-descriptor :name do-backups :initform t :type boolean :props ((:documentation . "Saving this object should make backup files.\nSetting to nil will mean no backups are made.")))] :class-allocation-values [".eieio" ";; EIEIO PERSISTENT OBJECT" t] :default-object-cache #<classy classy> :options (:custom-groups nil)) teacher (person "person" :name "Jane"))
  eieio-persistent-convert-list-to-object((classy "classy" :file "classy-26.0.90.eieio" :teacher (person "person" :name "Jane") :students #<hash-table eql 1/65 0x237e271>))
  eieio-persistent-read("classy-26.0.90.eieio" classy t)
  (let* ((jane (make-instance 'person :name "Jane")) (bob (make-instance 'person :name "Bob")) (class (make-instance 'classy :teacher jane :file (concat "classy-" emacs-version ".eieio")))) (puthash "Bob" bob (slot-value class 'students)) (eieio-persistent-save class (concat "classy-" emacs-version ".eieio")) (eieio-persistent-read (concat "classy-" emacs-version ".eieio") 'classy t))
  (progn (let* ((jane (make-instance 'person :name "Jane")) (bob (make-instance 'person :name "Bob")) (class (make-instance 'classy :teacher jane :file (concat "classy-" emacs-version ".eieio")))) (puthash "Bob" bob (slot-value class 'students)) (eieio-persistent-save class (concat "classy-" emacs-version ".eieio")) (eieio-persistent-read (concat "classy-" emacs-version ".eieio") 'classy t)))
  eval((progn (let* ((jane (make-instance 'person :name "Jane")) (bob (make-instance 'person :name "Bob")) (class (make-instance 'classy :teacher jane :file (concat "classy-" emacs-version ".eieio")))) (puthash "Bob" bob (slot-value class 'students)) (eieio-persistent-save class (concat "classy-" emacs-version ".eieio")) (eieio-persistent-read (concat "classy-" emacs-version ".eieio") 'classy t))) t)
  elisp--eval-last-sexp(nil)
  eval-last-sexp(nil)
  funcall-interactively(eval-last-sexp nil)
  call-interactively(eval-last-sexp nil nil)
  command-execute(eval-last-sexp)
#+END_SRC

;;; -*- lexical-binding: t -*-
(require 'eieio)
(require 'eieio-base)

(defclass person ()
  ((name :type string :initarg :name)))

(defclass classy (eieio-persistent)
  ((teacher
    :type person
    :initarg :teacher)
   (students
    :initarg :students :initform (make-hash-table))))

(let* ((jane (make-instance 'person :name "Jane"))
       (bob  (make-instance 'person :name "Bob"))
       (class (make-instance 'classy
			     :teacher jane
			     :file (concat "classy-" emacs-version ".eieio"))))
  (puthash "Bob" bob (slot-value class 'students))
  (eieio-persistent-save class (concat "classy-" emacs-version ".eieio"))
  (eieio-persistent-read (concat "classy-" emacs-version ".eieio") 'classy t))
;;; eieio-test-persist.el --- Tests for eieio-persistent class

;; Copyright (C) 2011-2017 Free Software Foundation, Inc.

;; Author: Eric M. Ludlam <[email-masked]>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; The eieio-persistent base-class provides a vital service, that
;; could be used to accidentally load in malicious code.  As such,
;; something as simple as calling eval on the generated code can't be
;; used.  These tests exercises various flavors of data that might be
;; in a persistent object, and tries to save/load them.

;;; Code:
(require 'eieio)
(require 'eieio-base)
(require 'ert)

(defun eieio--attribute-to-initarg (class attribute)
  "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag.
This is usually a symbol that starts with `:'."
  (let ((tuple (rassoc attribute (eieio--class-initarg-tuples class))))
    (if tuple
	(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."

  (eieio-persistent-save original)

  (let* ((file (oref original file))
	 (class (eieio-object-class original))
	 (fromdisk (eieio-persistent-read file class))
	 (cv (cl--find-class class))
	 (slots  (eieio--class-slots cv)))

    (unless (object-of-class-p fromdisk class)
      (error "Persistent class %S != original class %S"
	     (eieio-object-class fromdisk)
	     class))

    (dotimes (i (length slots))
      (let* ((slot (aref slots i))
             (oneslot (cl--slot-descriptor-name slot))
	     (origvalue (eieio-oref original oneslot))
	     (fromdiskvalue (eieio-oref fromdisk oneslot))
	     (initarg-p (eieio--attribute-to-initarg
                         (cl--find-class class) oneslot)))

	(if initarg-p
	    (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
	  (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 diskval origvalue))))
	))))

;;; Simple Case
;;
;; Simplest case is a mix of slots with and without initargs.

(defclass persist-simple (eieio-persistent)
  ((slot1 :initarg :slot1
	  :type symbol
	  :initform moose)
   (slot2 :initarg :slot2
	  :initform "foo")
   (slot3 :initform 2))
  "A Persistent object with two initializable slots, and one not.")

(ert-deftest eieio-test-persist-simple-1 ()
  (let ((persist-simple-1
	 (persist-simple "simple 1" :slot1 'goose :slot2 "testing"
			 :file (concat default-directory "test-ps1.pt"))))
    (should persist-simple-1)

    ;; When the slot w/out an initarg has not been changed
    (persist-test-save-and-compare persist-simple-1)

    ;; When the slot w/out an initarg HAS been changed
    (oset persist-simple-1 slot3 3)
    (persist-test-save-and-compare persist-simple-1)
    (delete-file (oref persist-simple-1 file))))

;;; Slot Writers
;;
;; Replica of the test in eieio-tests.el -

(defclass persist-:printer (eieio-persistent)
  ((slot1 :initarg :slot1
	  :initform 'moose
	  :printer PO-slot1-printer)
   (slot2 :initarg :slot2
	  :initform "foo"))
  "A Persistent object with two initializable slots.")

(defun PO-slot1-printer (slotvalue)
  "Print the slot value SLOTVALUE to stdout.
Assume SLOTVALUE is a symbol of some sort."
  (princ "'")
  (princ (symbol-name slotvalue))
  (princ " ;; RAN PRINTER")
  nil)

(ert-deftest eieio-test-persist-printer ()
  (let ((persist-:printer-1
	 (persist-:printer "persist" :slot1 'goose :slot2 "testing"
			   :file (concat default-directory "test-ps2.pt"))))
    (should persist-:printer-1)
    (persist-test-save-and-compare persist-:printer-1)

    (let* ((find-file-hook nil)
	   (tbuff (find-file-noselect "test-ps2.pt"))
	   )
      (condition-case nil
	  (unwind-protect
	      (with-current-buffer tbuff
		(goto-char (point-min))
		(re-search-forward "RAN PRINTER"))
	    (kill-buffer tbuff))
	(error "persist-:printer-1's Slot1 printer function didn't work.")))
    (delete-file (oref persist-:printer-1 file))))

;;; Slot with Object
;;
;; A slot that contains another object that isn't persistent
(defclass persist-not-persistent ()
  ((slot1 :initarg :slot1
	  :initform 1)
   (slot2 :initform 2))
  "Class for testing persistent saving of an object that isn't
persistent.  This class is instead used as a slot value in a
persistent class.")

(defclass persistent-with-objs-slot (eieio-persistent)
  ((pnp :initarg :pnp
	:type (or null persist-not-persistent)
	:initform nil))
  "Class for testing the saving of slots with objects in them.")

(ert-deftest eieio-test-non-persistent-as-slot ()
  (let ((persist-wos
	 (persistent-with-objs-slot
	  "persist wos 1"
	  :pnp (persist-not-persistent "pnp 1" :slot1 3)
	  :file (concat default-directory "test-ps3.pt"))))

    (persist-test-save-and-compare persist-wos)
    (delete-file (oref persist-wos file))))

;;; Slot with Object child of :type
;;
;; A slot that contains another object that isn't persistent
(defclass persist-not-persistent-subclass (persist-not-persistent)
  ((slot3 :initarg :slot1
	  :initform 1)
   (slot4 :initform 2))
  "Class for testing persistent saving of an object subclass that isn't
persistent.  This class is instead used as a slot value in a
persistent class.")

(defclass persistent-with-objs-slot-subs (eieio-persistent)
  ((pnp :initarg :pnp
	:type (or null persist-not-persistent)
	:initform nil))
  "Class for testing the saving of slots with objects in them.")

(ert-deftest eieio-test-non-persistent-as-slot-child ()
  (let ((persist-woss
	 (persistent-with-objs-slot-subs
	  "persist woss 1"
	  :pnp (persist-not-persistent-subclass "pnps 1" :slot1 3)
	  :file (concat default-directory "test-ps4.pt"))))

    (persist-test-save-and-compare persist-woss)
    (delete-file (oref persist-woss file))))

;; A slot that can contain one of two different classes, to exercise
;; the `or' slot type.

(defclass persistent-random-class ()
  ())

(defclass persistent-multiclass-slot (eieio-persistent)
  ((slot1 :initarg :slot1
          :type (or persistent-random-class null persist-not-persistent))
   (slot2 :initarg :slot2
          :type (or persist-not-persistent persist-random-class null))))

(ert-deftest eieio-test-multiple-class-slot ()
  (let ((persist
         (persistent-multiclass-slot "random string"
          :slot1 (persistent-random-class)
          :slot2 (persist-not-persistent)
          :file (concat default-directory "test-ps5.pt"))))
    (unwind-protect
        (persist-test-save-and-compare persist)
     (ignore-errors (delete-file (oref persist file))))))

;;; Slot with a list of Objects
;;
;; A slot that contains another object that isn't persistent
(defclass persistent-with-objs-list-slot (eieio-persistent)
  ((pnp :initarg :pnp
	:type (list-of persist-not-persistent)
	:initform nil))
  "Class for testing the saving of slots with objects in them.")

(ert-deftest eieio-test-slot-with-list-of-objects ()
  (let ((persist-wols
	 (persistent-with-objs-list-slot
	  "persist wols 1"
	  :pnp (list (persist-not-persistent "pnp 1" :slot1 3)
		     (persist-not-persistent "pnp 2" :slot1 4)
		     (persist-not-persistent "pnp 3" :slot1 5))
	  :file (concat default-directory "test-ps5.pt"))))

    (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))))

(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