persist/rtest.el

   1 ;;;_ tinydb/persist/rtest.el --- Rtest tests for persist
   2
   3 ;;;_. Headers
   4 ;;;_ , License
   5 ;; Copyright (C) 2010  Tom Breton (Tehom)
   6
   7 ;; Author: Tom Breton (Tehom) <tehom@panix.com>
   8 ;; Keywords: lisp, maint, internal
   9
  10 ;; This file is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; This file is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;;_ , Commentary:
  26
  27 ;;
  28
  29
  30 ;;;_ , Requires
  31
  32 (require 'tinydb/persist)
  33 (require 'emtest/testhelp/tagnames)
  34 (require 'emtest/testhelp/mocks/filebuf)
  35 (require 'emtest/testhelp/testpoint)
  36 (require 'timer)
  37
  38 ;;;_. Body
  39 ;;;_  . Test data
  40
  41 (defconst persist:th:examples-dir
  42    (emtb:expand-filename-by-load-file "examples/")
  43    "Directory where examples are" )
  44
  45 ;;The roles here are out of sync
  46 (defconst tinydb:thd:examples
  47    (emtg:define+ ;;xmp:b5d33625-bd1d-49d3-9c56-148b699eba99
  48       ((project emtest)(library persist))
  49       (group ((type filename))
  50          (item ((role master))
  51             (expand-file-name "1" persist:th:examples-dir))
  52          (item ((role slave))
  53             (expand-file-name "2" persist:th:examples-dir)))
  54
  55       (group ((creation-time before))
  56          (item ((type data)) '(1 10 500)))
  57
  58       (group ((creation-time now))
  59          (item ((type data)) '(56 25 17)))))
  60
  61
  62 ;;;_   , tehom-persist-buffer-as-const-list
  63 ;;$$OBSOLESCENT.
  64 '
  65 (rtest:deftest tehom-persist-buffer-as-const-list
  66
  67    (  "Situation: The file exists; we know what data it contains.
  68 Operation: Get that data
  69 Result: The data is what we expect."
  70       (emtg:with tinydb:thd:examples
  71          ((project emtest)(library persist))
  72          (tehom-persist-buffer-as-const-list
  73             (emtg (type filename)(role master))
  74             a
  75             (equal a
  76                (emtg (type data)(creation-time before))))))
  77
  78    (  "Situation: The file doesn't exist.
  79 Result: It returns the initial value - which is ()
  80 This does not attempt to create the file or save the buffer."
  81       (emtg:with tinydb:thd:examples
  82          ((project emtest)(library persist))
  83          (emtb:with-file-f (:absent t) filename
  84             (let
  85                (
  86                   ;;Tiny touch of psychic here: we know that the initial
  87                   ;;list value is ().
  88                   (initial-value ()))
  89                (tehom-persist-buffer-as-const-list
  90                   filename
  91                   a
  92                   (assert
  93                      (equal a initial-value)
  94                      t))
  95                t))))
  96
  97    )
  98 ;;;_   , tinydb/buffer Same tests on the alist wrt files
  99
 100 (rtest:deftest tinydb/buffer
 101
 102    (  "Situation: The file exists; we know what data it contains.
 103 Operation: Get that data
 104 Result: The data is what we expect."
 105       (emtg:with tinydb:thd:examples
 106          ((project emtest)(library persist))
 107          (let
 108             ((filetq
 109                 (tinydb-persist-make-q
 110                    ;;Filename
 111                    (emtg (type filename)(role master))
 112                    ;;Initial object
 113                    '()
 114                    t)))
 115
 116             ;;Test that we can read it.
 117             (assert
 118                (equal
 119                   (tinydb-get-obj filetq)
 120                   (emtg (type data)(creation-time before))))
 121             t)))
 122
 123
 124    (  "Situation: The file doesn't exist.
 125 Result: It returns the initial value.
 126 This does not attempt to create the file or save the buffer."
 127       (emtg:with tinydb:thd:examples
 128          ((project emtest)(library persist))
 129          (emtb:with-file-f (:absent t) filename
 130             (let*
 131                (
 132                   (initial-value '(a b c))
 133                   (filetq
 134                      (tinydb-persist-make-q
 135                         ;;Filename
 136                         filename
 137                         ;;Initial object
 138                         initial-value
 139                         nil)))
 140                (assert
 141                   (equal
 142                      (tinydb-get-obj filetq)
 143                      initial-value))
 144                ;;The file still doesn't exist, because it was not
 145                ;;eager-save and no operation we did should have forced
 146                ;;a save.
 147                (assert
 148                   (not (file-exists-p filename))
 149                   t)
 150                t))))
 151
 152    )
 153
 154 ;;;_   , tehom-persist-buffer-as-mutable-obj
 155 ;;$$OBSOLESCENT.
 156 (put 'tehom-persist-buffer-as-mutable-obj 'rtest:test-thru
 157    'tehom-persist-buffer-as-mutable-list)
 158 ;;;_   , tehom-persist-buffer-as-mutable-list
 159 ;;$$OBSOLESCENT.
 160 '
 161 (rtest:deftest tehom-persist-buffer-as-mutable-list
 162
 163    (  "Proves: Form return value is the same as body return value."
 164       (emtg:with tinydb:thd:examples
 165          ((project emtest)(library persist))
 166          (let*
 167             ((master-file
 168                 (emtg (role master)(type filename)))
 169                (ret-val
 170                   (tehom-persist-buffer-as-mutable-list
 171                      master-file a
 172                      135)))
 173
 174             (assert (equal ret-val 135) t)
 175             t)))
 176
 177    (  "Situation: Read a persisting object.
 178 Operation: Set a different value.  Read it as if fresh.
 179 Afterwards: It retains the new value."
 180       (emtg:with tinydb:thd:examples
 181          ((project emtest)(library persist))
 182          (emtb:with-file-f
 183             (:file (emtg (role master)(type filename)))
 184             filename
 185             (tehom-persist-buffer-as-mutable-list
 186                filename
 187                a
 188                ;;Validate: We got the expected original value.
 189                (equal a
 190                   (emtg (creation-time before)(type data)))
 191                ;;Set it to the now value.
 192                (setq a
 193                   (emtg (creation-time now)(type data))))
 194             ;;Read it as if fresh
 195             (tehom-persist-buffer-as-const-list
 196                filename
 197                a
 198                (equal a
 199                   (emtg (type data)(creation-time now)))))))
 200
 201
 202    (  "Situation: The file doesn't exist.
 203 Result: It returns the initial value - which is ()
 204 File now exists and contains the initial value."
 205       (emtg:with tinydb:thd:examples
 206          ((project emtest)(library persist))
 207          (emtb:with-file-f (:absent t) filename
 208             ;;Tiny touch of psychic here: we know that the initial
 209             ;;list value is ().
 210             (let
 211                (
 212                   (initial-value ()))
 213                (tehom-persist-buffer-as-mutable-list
 214                   filename
 215                   a
 216                   (assert
 217                      (equal a initial-value)
 218                      t))
 219                (assert
 220                   (file-exists-p filename)
 221                   t)
 222                (let*
 223                   ((text (emtb:file-contents-absname filename))
 224                      (obj (if text (read text))))
 225                   (assert
 226                      (equal obj
 227                         ())
 228                      t))
 229                t))))
 230
 231    )
 232 ;;;_   , tinydb/buffer/alist/mutate
 233 ;;New version
 234 (rtest:deftest tinydb/buffer/alist/mutate
 235
 236    (  "Situation: Read a persisting object.
 237 Operation: Set a different value.  Read it as if fresh.
 238 Afterwards: It retains the new value."
 239       (emtg:with tinydb:thd:examples
 240          ((project emtest)(library persist))
 241          (emtb:with-file-f
 242             (:file (emtg (role master)(type filename)))
 243             filename
 244             (let*
 245                (
 246                   (filetq
 247                      (tinydb-persist-make-q
 248                         ;;Filename
 249                         filename
 250                         ;;Initial object
 251                         '()
 252                         t)))
 253                ;;Validate: We got the expected original value.
 254                (assert
 255                   (equal
 256                      (tinydb-get-obj filetq)
 257                      (emtg (creation-time before)(type data)))
 258                   t)
 259
 260                ;;Set it to the new value.
 261                (tinydb-set-obj
 262                   filetq
 263                   (emtg (creation-time now)(type data)))
 264
 265                ;;The new value is immediately available.
 266                (let
 267                   ((value (tinydb-get-obj filetq)))
 268                   (assert
 269                      (equal
 270                         value
 271                         (emtg (creation-time now)(type data)))
 272                      t))
 273                t))))
 274
 275
 276    (  "Situation: The file doesn't exist.
 277 Result: It returns the initial value - which is ()
 278 File now exists and contains the initial value."
 279       (emtg:with tinydb:thd:examples
 280          ((project emtest)(library persist))
 281          (emtb:with-file-f (:absent t) filename
 282             (let*
 283                (
 284                   (initial-value '(12)) ;;Distinct from nil
 285                   (filetq
 286                      (tinydb-persist-make-q
 287                         ;;Filename
 288                         filename
 289                         ;;Initial object
 290                         initial-value
 291                         t)))
 292                (assert
 293                   (equal
 294                      (tinydb-get-obj filetq)
 295                      initial-value))
 296                ;;Eager save causes the file to exist.
 297                (assert
 298                   (file-exists-p filename)
 299                   t)
 300                ;;The file's contents are as expected.
 301                (let*
 302                   ((text (emtb:file-contents-absname filename))
 303                      (obj (if text (read text))))
 304                   (assert
 305                      (equal obj initial-value)
 306                      t))
 307                t))))
 308
 309    )
 310
 311 ;;;_   , tehom-update-persist-buffer
 312 ;;OBSOLESCENT
 313 '
 314 (rtest:deftest tehom-update-persist-buffer
 315
 316    (  "Operation: Write a different value.
 317 Afterwards: Read it as if fresh.  It retains the new value."
 318       (emtg:with tinydb:thd:examples
 319          ((project emtest)(library persist))
 320          (emtb:with-file-f
 321             (:file (emtg (role master)(type filename)))
 322             filename
 323             ;;Save the new value.
 324             (tehom-update-persist-buffer
 325                filename
 326                (emtg (creation-time now)(type data))
 327                t)
 328             ;;Read it as if fresh
 329             (tehom-persist-buffer-as-const-list
 330                filename
 331                a
 332                (equal a
 333                   (emtg (type data)(creation-time now)))))))
 334
 335    (  "Operation: Try to write a different value that fails the
 336 type-predicate.
 337 Result: Signal an error.
 338 Afterwards: Read it as if fresh.  It still has the old value."
 339       (emtg:with tinydb:thd:examples
 340          ((project emtest)(library persist))
 341          (emtb:with-file-f
 342             (:file (emtg (role master)(type filename))) filename
 343             ;;Try to save a value that fails the type predicate.
 344             ;;This must signal error.
 345             (assert
 346                (emth:gives-error
 347                   (tehom-update-persist-buffer
 348                      filename
 349                      'not-a-list
 350                      t
 351                      #'listp)))
 352             ;;Read it as if fresh
 353             (tehom-persist-buffer-as-const-list
 354                filename
 355                a
 356                ;;It still has the old value.
 357                (equal a
 358                   (emtg (type data)(creation-time before)))))))
 359
 360    (  "Operation: Try to write a value that can't be read - In fact, a
 361 buffer object.
 362 Result: Signal an error.
 363 Afterwards: Read it as if fresh.  It still has the old value."
 364       (emtg:with tinydb:thd:examples
 365          ((project emtest)(library persist))
 366          (emtb:with-file-f
 367             (:file (emtg (role master)(type filename))) filename
 368             ;;Try to save a value that fails the type predicate.
 369             ;;This must signal error.
 370             (assert
 371                (emth:gives-error
 372                   (tehom-update-persist-buffer
 373                      filename
 374                      (current-buffer)
 375                      t)))
 376             ;;Read it as if fresh
 377             (tehom-persist-buffer-as-const-list
 378                filename
 379                a
 380                ;;It still has the old value.
 381                (equal a
 382                   (emtg (type data)(creation-time before)))))))
 383
 384    )
 385
 386 ;;;_   , tinydb/buffer/update
 387 ;;New version
 388 (rtest:deftest tinydb/buffer/update
 389    (  "Operation: Try to write a different value that fails the
 390 type-predicate.
 391 Result: Signal an error.
 392 Afterwards: Read it as if fresh.  It still has the old value."
 393       (emtg:with tinydb:thd:examples
 394          ((project emtest)(library persist))
 395          (emtb:with-file-f
 396             (:file (emtg (role master)(type filename))) filename
 397
 398             (let*
 399                ((filetq
 400                    (tinydb-persist-make-q
 401                       ;;Filename
 402                       filename
 403                       ;;Initial object (Unused here)
 404                       '()
 405                       t
 406                       #'listp)))
 407                ;;Try to save a value that fails the type predicate.
 408                (tinydb-set-obj filetq 'not-a-list)
 409                ;;Object still has the old value.
 410                (assert
 411                   (equal
 412                      (tinydb-get-obj filetq)
 413                      (emtg (type data)(creation-time before))))
 414                t))))
 415
 416    ;;The last one remaining to convert
 417    (  "Operation: Try to write a value that can't be read - In fact, a
 418 buffer object.
 419 Result: Signal an error.
 420 Afterwards: Read it as if fresh.  It still has the old value."
 421       (emtg:with tinydb:thd:examples
 422          ((project emtest)(library persist))
 423          (emtb:with-file-f
 424             (:file (emtg (role master)(type filename))) filename
 425
 426             (let*
 427                ((filetq
 428                    (tinydb-persist-make-q
 429                       ;;Filename
 430                       filename
 431                       ;;Initial object (Unused here)
 432                       '()
 433                       t
 434                       #'listp)))
 435                ;;Try to save a value that can't be read.
 436                (tinydb-set-obj filetq (current-buffer))
 437                ;;Object still has the old value.
 438                (assert
 439                   (equal
 440                      (tinydb-get-obj filetq)
 441                      (emtg (type data)(creation-time before))))
 442                t))))
 443
 444    )
 445
 446
 447
 448 ;;;_. Footers
 449 ;;;_ , Provides
 450
 451 (provide 'tinydb/persist/rtest)
 452
 453 ;;;_ * Local emacs vars.
 454 ;;;_  + Local variables:
 455 ;;;_  + mode: allout
 456 ;;;_  + End:
 457
 458 ;;;_ , End
 459 ;;; tinydb/persist/rtest.el ends here