Commit | Line | Data |
---|---|---|
6ee60310 DE |
1 | ;;; eieio-persist.el --- Tests for eieio-persistent class |
2 | ||
ba318903 | 3 | ;; Copyright (C) 2011-2014 Free Software Foundation, Inc. |
6ee60310 DE |
4 | |
5 | ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | ||
7 | ;; This file is part of GNU Emacs. | |
8 | ||
9 | ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 | ;; it under the terms of the GNU General Public License as published by | |
11 | ;; the Free Software Foundation, either version 3 of the License, or | |
12 | ;; (at your option) any later version. | |
13 | ||
14 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 | ;; GNU General Public License for more details. | |
18 | ||
19 | ;; You should have received a copy of the GNU General Public License | |
20 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; The eieio-persistent base-class provides a vital service, that | |
25 | ;; could be used to accidentally load in malicious code. As such, | |
26 | ;; something as simple as calling eval on the generated code can't be | |
27 | ;; used. These tests exercises various flavors of data that might be | |
28 | ;; in a persistent object, and tries to save/load them. | |
29 | ||
30 | ;;; Code: | |
31 | (require 'eieio) | |
32 | (require 'eieio-base) | |
33 | (require 'ert) | |
34 | ||
35 | (defun persist-test-save-and-compare (original) | |
36 | "Compare the object ORIGINAL against the one read fromdisk." | |
37 | ||
38 | (eieio-persistent-save original) | |
39 | ||
40 | (let* ((file (oref original :file)) | |
41 | (class (eieio-object-class original)) | |
42 | (fromdisk (eieio-persistent-read file class)) | |
43 | (cv (class-v class)) | |
44 | (slot-names (eieio--class-public-a cv)) | |
45 | (slot-deflt (eieio--class-public-d cv)) | |
46 | ) | |
47 | (unless (object-of-class-p fromdisk class) | |
48 | (error "Persistent class %S != original class %S" | |
49 | (eieio-object-class fromdisk) | |
50 | class)) | |
51 | ||
52 | (while slot-names | |
53 | (let* ((oneslot (car slot-names)) | |
54 | (origvalue (eieio-oref original oneslot)) | |
55 | (fromdiskvalue (eieio-oref fromdisk oneslot)) | |
56 | (initarg-p (eieio-attribute-to-initarg class oneslot)) | |
57 | ) | |
58 | ||
59 | (if initarg-p | |
60 | (unless (equal origvalue fromdiskvalue) | |
61 | (error "Slot %S Original Val %S != Persistent Val %S" | |
62 | oneslot origvalue fromdiskvalue)) | |
63 | ;; Else !initarg-p | |
64 | (unless (equal (car slot-deflt) fromdiskvalue) | |
65 | (error "Slot %S Persistent Val %S != Default Value %S" | |
66 | oneslot fromdiskvalue (car slot-deflt)))) | |
67 | ||
68 | (setq slot-names (cdr slot-names) | |
69 | slot-deflt (cdr slot-deflt)) | |
70 | )))) | |
71 | ||
72 | ;;; Simple Case | |
73 | ;; | |
74 | ;; Simplest case is a mix of slots with and without initargs. | |
75 | ||
76 | (defclass persist-simple (eieio-persistent) | |
77 | ((slot1 :initarg :slot1 | |
78 | :type symbol | |
79 | :initform moose) | |
80 | (slot2 :initarg :slot2 | |
81 | :initform "foo") | |
82 | (slot3 :initform 2)) | |
83 | "A Persistent object with two initializable slots, and one not.") | |
84 | ||
85 | (ert-deftest eieio-test-persist-simple-1 () | |
86 | (let ((persist-simple-1 | |
87 | (persist-simple "simple 1" :slot1 'goose :slot2 "testing" | |
88 | :file (concat default-directory "test-ps1.pt")))) | |
89 | (should persist-simple-1) | |
90 | ||
91 | ;; When the slot w/out an initarg has not been changed | |
92 | (persist-test-save-and-compare persist-simple-1) | |
93 | ||
94 | ;; When the slot w/out an initarg HAS been changed | |
95 | (oset persist-simple-1 slot3 3) | |
96 | (persist-test-save-and-compare persist-simple-1) | |
97 | (delete-file (oref persist-simple-1 file)))) | |
98 | ||
99 | ;;; Slot Writers | |
100 | ;; | |
101 | ;; Replica of the test in eieio-tests.el - | |
102 | ||
103 | (defclass persist-:printer (eieio-persistent) | |
104 | ((slot1 :initarg :slot1 | |
105 | :initform 'moose | |
106 | :printer PO-slot1-printer) | |
107 | (slot2 :initarg :slot2 | |
108 | :initform "foo")) | |
109 | "A Persistent object with two initializable slots.") | |
110 | ||
111 | (defun PO-slot1-printer (slotvalue) | |
112 | "Print the slot value SLOTVALUE to stdout. | |
113 | Assume SLOTVALUE is a symbol of some sort." | |
114 | (princ "'") | |
115 | (princ (symbol-name slotvalue)) | |
116 | (princ " ;; RAN PRINTER") | |
117 | nil) | |
118 | ||
119 | (ert-deftest eieio-test-persist-printer () | |
120 | (let ((persist-:printer-1 | |
121 | (persist-:printer "persist" :slot1 'goose :slot2 "testing" | |
122 | :file (concat default-directory "test-ps2.pt")))) | |
123 | (should persist-:printer-1) | |
124 | (persist-test-save-and-compare persist-:printer-1) | |
125 | ||
126 | (let* ((find-file-hook nil) | |
127 | (tbuff (find-file-noselect "test-ps2.pt")) | |
128 | ) | |
129 | (condition-case nil | |
130 | (unwind-protect | |
131 | (with-current-buffer tbuff | |
132 | (goto-char (point-min)) | |
133 | (re-search-forward "RAN PRINTER")) | |
134 | (kill-buffer tbuff)) | |
135 | (error "persist-:printer-1's Slot1 printer function didn't work."))) | |
136 | (delete-file (oref persist-:printer-1 file)))) | |
137 | ||
138 | ;;; Slot with Object | |
139 | ;; | |
140 | ;; A slot that contains another object that isn't persistent | |
141 | (defclass persist-not-persistent () | |
142 | ((slot1 :initarg :slot1 | |
143 | :initform 1) | |
144 | (slot2 :initform 2)) | |
145 | "Class for testing persistent saving of an object that isn't | |
146 | persistent. This class is instead used as a slot value in a | |
147 | persistent class.") | |
148 | ||
149 | (defclass persistent-with-objs-slot (eieio-persistent) | |
150 | ((pnp :initarg :pnp | |
151 | :type (or null persist-not-persistent) | |
152 | :initform nil)) | |
153 | "Class for testing the saving of slots with objects in them.") | |
154 | ||
155 | (ert-deftest eieio-test-non-persistent-as-slot () | |
156 | (let ((persist-wos | |
157 | (persistent-with-objs-slot | |
158 | "persist wos 1" | |
159 | :pnp (persist-not-persistent "pnp 1" :slot1 3) | |
160 | :file (concat default-directory "test-ps3.pt")))) | |
161 | ||
162 | (persist-test-save-and-compare persist-wos) | |
163 | (delete-file (oref persist-wos file)))) | |
164 | ||
165 | ;;; Slot with Object child of :type | |
166 | ;; | |
167 | ;; A slot that contains another object that isn't persistent | |
168 | (defclass persist-not-persistent-subclass (persist-not-persistent) | |
169 | ((slot3 :initarg :slot1 | |
170 | :initform 1) | |
171 | (slot4 :initform 2)) | |
172 | "Class for testing persistent saving of an object subclass that isn't | |
173 | persistent. This class is instead used as a slot value in a | |
174 | persistent class.") | |
175 | ||
176 | (defclass persistent-with-objs-slot-subs (eieio-persistent) | |
177 | ((pnp :initarg :pnp | |
178 | :type (or null persist-not-persistent-child) | |
179 | :initform nil)) | |
180 | "Class for testing the saving of slots with objects in them.") | |
181 | ||
182 | (ert-deftest eieio-test-non-persistent-as-slot-child () | |
183 | (let ((persist-woss | |
184 | (persistent-with-objs-slot-subs | |
185 | "persist woss 1" | |
186 | :pnp (persist-not-persistent-subclass "pnps 1" :slot1 3) | |
187 | :file (concat default-directory "test-ps4.pt")))) | |
188 | ||
189 | (persist-test-save-and-compare persist-woss) | |
190 | (delete-file (oref persist-woss file)))) | |
191 | ||
192 | ;;; Slot with a list of Objects | |
193 | ;; | |
194 | ;; A slot that contains another object that isn't persistent | |
195 | (defclass persistent-with-objs-list-slot (eieio-persistent) | |
196 | ((pnp :initarg :pnp | |
197 | :type persist-not-persistent-list | |
198 | :initform nil)) | |
199 | "Class for testing the saving of slots with objects in them.") | |
200 | ||
201 | (ert-deftest eieio-test-slot-with-list-of-objects () | |
202 | (let ((persist-wols | |
203 | (persistent-with-objs-list-slot | |
204 | "persist wols 1" | |
205 | :pnp (list (persist-not-persistent "pnp 1" :slot1 3) | |
206 | (persist-not-persistent "pnp 2" :slot1 4) | |
207 | (persist-not-persistent "pnp 3" :slot1 5)) | |
208 | :file (concat default-directory "test-ps5.pt")))) | |
209 | ||
210 | (persist-test-save-and-compare persist-wols) | |
211 | (delete-file (oref persist-wols file)))) | |
212 | ||
213 | ;;; eieio-test-persist.el ends here |