test/automated/eieio-test-persist.el

   1 ;;; eieio-persist.el --- Tests for eieio-persistent class
   2
   3 ;; Copyright (C) 2011-2013 Free Software Foundation, Inc.
   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