test/automated/eieio-test-persist.el

   1 ;;; eieio-persist.el --- Tests for eieio-persistent class
   2
   3 ;; Copyright (C) 2011-2015 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 eieio--attribute-to-initarg (class attribute)
  36   "In CLASS, convert the ATTRIBUTE into the corresponding init argument tag.
  37 This is usually a symbol that starts with `:'."
  38   (let ((tuple (rassoc attribute (eieio--class-initarg-tuples class))))
  39     (if tuple
  40         (car tuple)
  41       nil)))
  42
  43 (defun persist-test-save-and-compare (original)
  44   "Compare the object ORIGINAL against the one read fromdisk."
  45
  46   (eieio-persistent-save original)
  47
  48   (let* ((file (oref original file))
  49          (class (eieio-object-class original))
  50          (fromdisk (eieio-persistent-read file class))
  51          (cv (cl--find-class class))
  52          (slots  (eieio--class-slots cv))
  53          )
  54     (unless (object-of-class-p fromdisk class)
  55       (error "Persistent class %S != original class %S"
  56              (eieio-object-class fromdisk)
  57              class))
  58
  59     (dotimes (i (length slots))
  60       (let* ((slot (aref slots i))
  61              (oneslot (cl--slot-descriptor-name slot))
  62              (origvalue (eieio-oref original oneslot))
  63              (fromdiskvalue (eieio-oref fromdisk oneslot))
  64              (initarg-p (eieio--attribute-to-initarg
  65                          (cl--find-class class) oneslot))
  66              )
  67
  68         (if initarg-p
  69             (unless (equal origvalue fromdiskvalue)
  70               (error "Slot %S Original Val %S != Persistent Val %S"
  71                      oneslot origvalue fromdiskvalue))
  72           ;; Else !initarg-p
  73           (unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue)
  74             (error "Slot %S Persistent Val %S != Default Value %S"
  75                    oneslot fromdiskvalue (cl--slot-descriptor-initform slot))))
  76         ))))
  77
  78 ;;; Simple Case
  79 ;;
  80 ;; Simplest case is a mix of slots with and without initargs.
  81
  82 (defclass persist-simple (eieio-persistent)
  83   ((slot1 :initarg :slot1
  84           :type symbol
  85           :initform moose)
  86    (slot2 :initarg :slot2
  87           :initform "foo")
  88    (slot3 :initform 2))
  89   "A Persistent object with two initializable slots, and one not.")
  90
  91 (ert-deftest eieio-test-persist-simple-1 ()
  92   (let ((persist-simple-1
  93          (persist-simple "simple 1" :slot1 'goose :slot2 "testing"
  94                          :file (concat default-directory "test-ps1.pt"))))
  95     (should persist-simple-1)
  96
  97     ;; When the slot w/out an initarg has not been changed
  98     (persist-test-save-and-compare persist-simple-1)
  99
 100     ;; When the slot w/out an initarg HAS been changed
 101     (oset persist-simple-1 slot3 3)
 102     (persist-test-save-and-compare persist-simple-1)
 103     (delete-file (oref persist-simple-1 file))))
 104
 105 ;;; Slot Writers
 106 ;;
 107 ;; Replica of the test in eieio-tests.el -
 108
 109 (defclass persist-:printer (eieio-persistent)
 110   ((slot1 :initarg :slot1
 111           :initform 'moose
 112           :printer PO-slot1-printer)
 113    (slot2 :initarg :slot2
 114           :initform "foo"))
 115   "A Persistent object with two initializable slots.")
 116
 117 (defun PO-slot1-printer (slotvalue)
 118   "Print the slot value SLOTVALUE to stdout.
 119 Assume SLOTVALUE is a symbol of some sort."
 120   (princ "'")
 121   (princ (symbol-name slotvalue))
 122   (princ " ;; RAN PRINTER")
 123   nil)
 124
 125 (ert-deftest eieio-test-persist-printer ()
 126   (let ((persist-:printer-1
 127          (persist-:printer "persist" :slot1 'goose :slot2 "testing"
 128                            :file (concat default-directory "test-ps2.pt"))))
 129     (should persist-:printer-1)
 130     (persist-test-save-and-compare persist-:printer-1)
 131
 132     (let* ((find-file-hook nil)
 133            (tbuff (find-file-noselect "test-ps2.pt"))
 134            )
 135       (condition-case nil
 136           (unwind-protect
 137               (with-current-buffer tbuff
 138                 (goto-char (point-min))
 139                 (re-search-forward "RAN PRINTER"))
 140             (kill-buffer tbuff))
 141         (error "persist-:printer-1's Slot1 printer function didn't work.")))
 142     (delete-file (oref persist-:printer-1 file))))
 143
 144 ;;; Slot with Object
 145 ;;
 146 ;; A slot that contains another object that isn't persistent
 147 (defclass persist-not-persistent ()
 148   ((slot1 :initarg :slot1
 149           :initform 1)
 150    (slot2 :initform 2))
 151   "Class for testing persistent saving of an object that isn't
 152 persistent.  This class is instead used as a slot value in a
 153 persistent class.")
 154
 155 (defclass persistent-with-objs-slot (eieio-persistent)
 156   ((pnp :initarg :pnp
 157         :type (or null persist-not-persistent)
 158         :initform nil))
 159   "Class for testing the saving of slots with objects in them.")
 160
 161 (ert-deftest eieio-test-non-persistent-as-slot ()
 162   (let ((persist-wos
 163          (persistent-with-objs-slot
 164           "persist wos 1"
 165           :pnp (persist-not-persistent "pnp 1" :slot1 3)
 166           :file (concat default-directory "test-ps3.pt"))))
 167
 168     (persist-test-save-and-compare persist-wos)
 169     (delete-file (oref persist-wos file))))
 170
 171 ;;; Slot with Object child of :type
 172 ;;
 173 ;; A slot that contains another object that isn't persistent
 174 (defclass persist-not-persistent-subclass (persist-not-persistent)
 175   ((slot3 :initarg :slot1
 176           :initform 1)
 177    (slot4 :initform 2))
 178   "Class for testing persistent saving of an object subclass that isn't
 179 persistent.  This class is instead used as a slot value in a
 180 persistent class.")
 181
 182 (defclass persistent-with-objs-slot-subs (eieio-persistent)
 183   ((pnp :initarg :pnp
 184         :type (or null persist-not-persistent)
 185         :initform nil))
 186   "Class for testing the saving of slots with objects in them.")
 187
 188 (ert-deftest eieio-test-non-persistent-as-slot-child ()
 189   (let ((persist-woss
 190          (persistent-with-objs-slot-subs
 191           "persist woss 1"
 192           :pnp (persist-not-persistent-subclass "pnps 1" :slot1 3)
 193           :file (concat default-directory "test-ps4.pt"))))
 194
 195     (persist-test-save-and-compare persist-woss)
 196     (delete-file (oref persist-woss file))))
 197
 198 ;;; Slot with a list of Objects
 199 ;;
 200 ;; A slot that contains another object that isn't persistent
 201 (defclass persistent-with-objs-list-slot (eieio-persistent)
 202   ((pnp :initarg :pnp
 203         :type (list-of persist-not-persistent)
 204         :initform nil))
 205   "Class for testing the saving of slots with objects in them.")
 206
 207 (ert-deftest eieio-test-slot-with-list-of-objects ()
 208   (let ((persist-wols
 209          (persistent-with-objs-list-slot
 210           "persist wols 1"
 211           :pnp (list (persist-not-persistent "pnp 1" :slot1 3)
 212                      (persist-not-persistent "pnp 2" :slot1 4)
 213                      (persist-not-persistent "pnp 3" :slot1 5))
 214           :file (concat default-directory "test-ps5.pt"))))
 215
 216     (persist-test-save-and-compare persist-wols)
 217     (delete-file (oref persist-wols file))))
 218
 219 ;;; eieio-test-persist.el ends here