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