Package: emacs;
Reported by: pierre.techoueyres <at> free.fr (Pierre Téchoueyres)
Date: Wed, 8 Nov 2017 22:20:01 UTC
Severity: normal
Merged with 33441
Found in version 26.0.90
Message #129 received at 29220 <at> debbugs.gnu.org (full text, mbox):
From: pierre.techoueyres <at> free.fr (Pierre Téchoueyres) To: Noam Postavsky <npostavs <at> users.sourceforge.net> Cc: Eric Abrahamsen <eric <at> ericabrahamsen.net>, jwiegley <at> gmail.com, 29220 <at> debbugs.gnu.org, monnier <at> iro.umontreal.ca Subject: Re: bug#29220: 26.0.90; eieio-persistent-read fail to restore saved object. Date: Fri, 15 Dec 2017 21:26:06 +0100
[Message part 1 (text/plain, inline)]
Noam Postavsky <npostavs <at> users.sourceforge.net> 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
[eieio-fail-1.el (text/plain, inline)]
;;; -*- 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 (text/plain, inline)]
;;; eieio-test-persist.el --- Tests for eieio-persistent class
;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric <at> siege-engine.com>
;; 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.