persist/tests.el

   1 ;;;_ tinydb/persist/tests.el ---  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 (defconst persist:th:examples-dir
  38    (emtb:expand-filename-by-load-file "examples/")
  39    "Directory where examples are" )
  40
  41 ;;;_. Body
  42 ;;;_  . Test data
  43
  44 ;;The roles here are out of sync
  45 (defconst tinydb/persist:thd:examples
  46    (emtg:define+ ;;xmp:b5d33625-bd1d-49d3-9c56-148b699eba99
  47       ((project emtest)(library persist))
  48       (group ((type filename))
  49          (item ((role master))
  50             (expand-file-name "1" persist:th:examples-dir))
  51          (item ((role slave))
  52             (expand-file-name "2" persist:th:examples-dir)))
  53
  54       (group ((creation-time before))
  55          (item ((type data)) '(1 10 500)))
  56
  57       (group ((creation-time now))
  58          (item ((type data)) '(56 25 17)))))
  59
  60
  61 ;;;_   , tinydb/buffer Same tests on the alist wrt files
  62
  63 (emt:deftest-3 tinydb/buffer
  64    (()
  65       (emtg:with tinydb/persist:thd:examples
  66          ((project emtest)(library persist))
  67          (let
  68             ((filetq
  69                 (tinydb-persist-make-q
  70                    ;;Filename
  71                    (emtg (type filename)(role master))
  72                    ;;Initial object
  73                    '()
  74                    t)))
  75             (emt:doc
  76                "Situation: The file exists; we know what data it contains.")
  77
  78             ;;Test that we can read it.
  79             (emt:doc "Operation: Get that data.")
  80             (emt:doc "Result: The data is what we expect.")
  81             (assert
  82                (equal
  83                   (tinydb-get-obj filetq)
  84                   (emtg (type data)(creation-time before)))))))
  85    (nil
  86       (emtg:with tinydb/persist:thd:examples
  87          ((project emtest)(library persist))
  88          (emtb:with-file-f (:absent t) filename
  89             (let*
  90                (
  91                   (initial-value ())
  92                   (filetq
  93                      (tinydb-persist-make-q
  94                         ;;Filename
  95                         filename
  96                         ;;Initial object
  97                         initial-value
  98                         nil)))
  99                (emt:doc "Situation: The file doesn't already exist.")
 100                (emt:doc "Param: The eager-save flag is nil.")
 101                (emt:doc "Operation: read from the filetq.")
 102                (emt:doc "Result: It returns the initial value.")
 103
 104                (assert
 105                   (equal
 106                      (tinydb-get-obj filetq)
 107                      initial-value))
 108
 109                ;;The file still doesn't exist, because it was not
 110                ;;eager-save and no operation we did should have
 111                ;;forced a save.
 112                (emt:doc "Check: Whether the file exists now.")
 113                (emt:doc "Result: It returns the initial value.")
 114                (assert
 115                   (not (file-exists-p filename))
 116                   t)
 117                t))))
 118    )
 119
 120 ;;;_   , tinydb/buffer/alist/mutate
 121 (emt:deftest-3  tinydb/buffer/alist/mutate
 122
 123    (  ()
 124       (emtg:with tinydb/persist:thd:examples
 125          ((project emtest)(library persist))
 126          (emtb:with-file-f
 127             (:file (emtg (role master)(type filename)))
 128             filename
 129             (emt:doc "Situation: Read a persisting object.")
 130             (emt:doc "Operation: Set a different value.  Read it as if fresh.")
 131             (emt:doc "Afterwards: It retains the new value.")
 132             (let*
 133                (
 134                   (filetq
 135                      (tinydb-persist-make-q
 136                         ;;Filename
 137                         filename
 138                         ;;Initial object
 139                         '()
 140                         t)))
 141                ;;Validate: We got the expected original value.
 142                (assert
 143                   (equal
 144                      (tinydb-get-obj filetq)
 145                      (emtg (creation-time before)(type data)))
 146                   t)
 147
 148                ;;Set it to the new value.
 149                (tinydb-set-obj
 150                   filetq
 151                   (emtg (creation-time now)(type data)))
 152
 153                ;;The new value is immediately available.
 154                (let
 155                   ((value (tinydb-get-obj filetq)))
 156                   (assert
 157                      (equal
 158                         value
 159                         (emtg (creation-time now)(type data)))
 160                      t))
 161                t))))
 162
 163
 164    (  ()
 165       (emtg:with tinydb/persist:thd:examples
 166          ((project emtest)(library persist))
 167          (emtb:with-file-f (:absent t) filename
 168             (let*
 169                (
 170                   (initial-value '(12)) ;;Distinct from nil
 171                   (filetq
 172                      (tinydb-persist-make-q
 173                         ;;Filename
 174                         filename
 175                         ;;Initial object
 176                         initial-value
 177                         t)))
 178                (emt:doc "Situation: The file doesn't yet exist.")
 179                (emt:doc "Situation: The eager-save flag is set.")
 180
 181                ;;Eager save causes the file to exist.
 182                (emt:doc "Afterwards: File now exists.")
 183                (assert
 184                   (file-exists-p filename)
 185                   t)
 186
 187                (emt:doc "Afterwards: file's contents are the initial value.")
 188                (let*
 189                   ((text (emtb:file-contents-absname filename))
 190                      (obj (if text (read text))))
 191                   (assert
 192                      (equal obj initial-value)
 193                      t))
 194                (emt:doc "Operation: Read it.")
 195                (emt:doc "Result: It returns the initial value.")
 196                (assert
 197                   (equal
 198                      (tinydb-get-obj filetq)
 199                      initial-value))
 200                ))))
 201
 202    )
 203
 204 ;;;_   , tinydb/buffer/update
 205 (emt:deftest-3 tinydb/buffer/update
 206    (nil
 207       (progn
 208          (emt:doc "Operation: Try to write a different value that fails the
 209 type-predicate.")
 210          (emt:doc "Result: Signal an error.")
 211          (emt:doc "Afterwards: Read it as if fresh.  It still has the old value.")
 212          (emtg:with tinydb/persist:thd:examples
 213             ((project emtest)
 214                (library persist))
 215             (emtb:with-file-f
 216                (:file
 217                   (emtg
 218                      (role master)
 219                      (type filename)))
 220                filename
 221                (let*
 222                   ((filetq
 223                       (tinydb-persist-make-q filename 'nil t #'listp)))
 224                   (emt:doc "Operation: Try to save a value that fails the type predicate.")
 225                   (tinydb-set-obj filetq 'not-a-list)
 226                   (emt:doc "Result: Object still has the old value.")
 227                   (assert
 228                      (equal
 229                         (tinydb-get-obj filetq)
 230                         (emtg
 231                            (type data)
 232                            (creation-time before))))
 233                   t)))))
 234    (nil
 235       (progn
 236          (emt:doc "Operation: Try to write a value that can't be read - In fact, a
 237 buffer object.")
 238          (emt:doc "Result: Signal an error.
 239 ")
 240          (emt:doc "Afterwards: Read it as if fresh.  It still has the old value.")
 241          (emtg:with tinydb/persist:thd:examples
 242             ((project emtest)
 243                (library persist))
 244             (emtb:with-file-f
 245                (:file
 246                   (emtg
 247                      (role master)
 248                      (type filename)))
 249                filename
 250                (let*
 251                   ((filetq
 252                       (tinydb-persist-make-q filename 'nil t #'listp)))
 253                   (emt:doc "Operation: Try to save a value that can't be read.")
 254                   (tinydb-set-obj filetq
 255                      (current-buffer))
 256                   (emt:doc "Result: Object still has the old value.")
 257                   (assert
 258                      (equal
 259                         (tinydb-get-obj filetq)
 260                         (emtg
 261                            (type data)
 262                            (creation-time before))))
 263                   t))))))
 264
 265 ;;;_   , Test helpers
 266 (defun persist:th:make-usual-tq (initial)
 267    ""
 268    (tinydb-make-q
 269       ;;Create.
 270       #'identity
 271       ;;Get
 272       #'identity
 273       ;;Put
 274       #'(lambda (old-obj obj)
 275            obj)
 276       ;;Type predicate that always passes
 277       #'list
 278       ;;Initial value
 279       initial
 280       ))
 281 ;;;_   , tinydb-alist-push
 282 (emt:deftest-3 tinydb-alist-push
 283    (nil
 284       (progn
 285          (emt:doc "Proves: Can write to it (via `tinydb-alist-push').")
 286          (with-timeout
 287             (1.5)
 288             (let
 289                ((list 'nil)
 290                   (tq
 291                      (persist:th:make-usual-tq
 292                         '((b . 144)))))
 293                (tinydb-alist-push tq 'a 12)
 294                (tinydb-q-do-pending tq)
 295                (assert
 296                   (equal
 297                      (tinydb-q->obj tq)
 298                      '((a . 12) (b . 144)))
 299                   t)
 300                t)))))
 301
 302
 303 ;;;_   , tinydb-alist-assoc
 304 (emt:deftest-3 tinydb-alist-assoc
 305    (nil
 306       (progn
 307          (emt:doc "Proves: Can read from it via `tinydb-alist-assoc'.")
 308          (with-timeout
 309             (1.5)
 310             (let*
 311                ((list 'nil)
 312                   (tq
 313                      (persist:th:make-usual-tq
 314                         '((a 144))))
 315                   (result
 316                      (tinydb-alist-assoc tq 'a)))
 317                (assert
 318                   (equal
 319                      (tinydb-q->obj tq)
 320                      '((a 144)))
 321                   t)
 322                (assert
 323                   (equal result
 324                      '(a 144))
 325                   t)
 326                t)))))
 327
 328
 329 ;;;_   , Reentrancy tests
 330
 331 ;;These tests are theoretically sensitive to processor speed, but the
 332 ;;specified durations are extremely generous so there shouldn't be a
 333 ;;problem.
 334 (emt:deftest-3 tinydb/reentrancy
 335    (nil
 336       (progn
 337          (emt:doc "Proves: Timer events can run during sleep-for.")
 338          (let
 339             ((recorded 'nil))
 340             (run-with-timer 0.1 nil
 341                #'(lambda nil
 342                     (push
 343                        (list 'timed
 344                           (current-time))
 345                        recorded)))
 346             (sleep-for 1.0)
 347             (push
 348                (list 'delayed
 349                   (current-time))
 350                recorded)
 351             (assert
 352                (assq 'timed recorded)
 353                t)
 354             (assert
 355                (assq 'delayed recorded)
 356                t)
 357             (let*
 358                ((timed-ran-at
 359                    (second
 360                       (assq 'timed recorded)))
 361                   (delayed-ran-at
 362                      (second
 363                         (assq 'delayed recorded)))
 364                   (time-diff
 365                      (time-subtract delayed-ran-at timed-ran-at)))
 366                (assert
 367                   (time-less-p time-diff
 368                      (seconds-to-time 0.99))
 369                   t)
 370                (assert
 371                   (time-less-p
 372                      (seconds-to-time 0.8)
 373                      time-diff)
 374                   t)
 375                t))))
 376    (nil
 377       (progn
 378          (emt:doc "Proves: Validates the testing mechanism with sit-for vs a
 379       single timer.")
 380          (with-timeout
 381             (1.5)
 382             (let
 383                ((list 'nil))
 384                (run-with-timer 0.2 nil
 385                   #'(lambda nil
 386                        (push "Start 2" list)
 387                        (sit-for 0.2)
 388                        (push "End 2" list)))
 389                (push "Start test" list)
 390                (sit-for 0.2)
 391                (push "End test" list)
 392                (assert
 393                   (equal
 394                      (reverse list)
 395                      '("Start test" "Start 2" "End 2" "End test"))
 396                   t)
 397                t))))
 398    (nil
 399       (progn
 400          (emt:doc "Proves: Validates the testing mechanism with multiple run-with-timers.
 401       (which somehow nests their sit-for calls)")
 402          (with-timeout
 403             (1.5)
 404             (let
 405                ((list 'nil))
 406                (run-with-timer 0.1 nil
 407                   #'(lambda nil
 408                        (push "Start 1" list)
 409                        (sit-for 0.1)
 410                        (sit-for 0.1)
 411                        (push "End 1" list)))
 412                (run-with-timer 0.2 nil
 413                   #'(lambda nil
 414                        (push "Start 2" list)
 415                        (sit-for 0.1)
 416                        (sit-for 0.1)
 417                        (push "End 2" list)))
 418                (push "Start test" list)
 419                (sit-for 0.6)
 420                (push "End test" list)
 421                (assert
 422                   (equal
 423                      (reverse list)
 424                      '("Start test" "Start 1" "Start 2" "End 2" "End 1" "End test"))
 425                   t)
 426                t))))
 427    (nil
 428       (progn
 429          (emt:doc "Proves: Can see the internal object (at all).")
 430          (with-timeout
 431             (1.5)
 432             (let*
 433                ((list 'nil)
 434                   (tq
 435                      (persist:th:make-usual-tq
 436                         '(144)))
 437                   (result nil))
 438                (tinydb-q-will-call tq t
 439                   #'(lambda
 440                        (obj)
 441                        (setq result obj)))
 442                (assert
 443                   (equal
 444                      (tinydb-q->obj tq)
 445                      '(144))
 446                   t)
 447                (assert
 448                   (equal result
 449                      '(144))
 450                   t)
 451                t))))
 452    (nil
 453       (progn
 454          (emt:doc "Proves: Calling `tinydb-q-will-call' recursively in handler
 455       gives an error.
 456 FIX ME:  This logic has changed.  Now it's only reads that require
 457 errors to be raised.
 458 ")
 459          (with-timeout
 460             (1.5)
 461             (let
 462                ((list 'nil)
 463                   (tq
 464                      (persist:th:make-usual-tq
 465                         '(144))))
 466                (push "Start test" list)
 467                (tinydb-q-will-call tq nil
 468                   #'(lambda
 469                        (obj)
 470                        (assert
 471                           (emth:gives-error
 472                              (tinydb-q-will-call tq t #'identity))
 473                           t)))
 474                (push "End test" list)
 475                (assert
 476                   (equal
 477                      (reverse list)
 478                      '("Start test" "End test"))
 479                   t)
 480                (assert
 481                   (equal
 482                      (tinydb-q->obj tq)
 483                      '(144))
 484                   t)
 485                t))))
 486    '
 487    (nil
 488       (progn
 489          (emt:doc "Proves: Can write asynchronously to it.")
 490          (with-timeout
 491             (1.5)
 492             (let
 493                ((list 'nil)
 494                   (tq
 495                      (persist:th:make-usual-tq
 496                         '(144))))
 497                (push "Start test" list)
 498                (run-with-timer 0.1 nil
 499                   #'(lambda
 500                        (arg)
 501                        (push "Start 1" list)
 502                        (tinydb-q-will-call tq nil
 503                           #'(lambda
 504                                (obj x)
 505                                (sleep-for 0.2)
 506                                (push "End 1" list)
 507                                (throw 'tinydb-q-new-obj
 508                                   (cons x obj)))
 509                           arg))
 510                   12)
 511                (run-with-timer 0.2 nil
 512                   #'(lambda
 513                        (arg)
 514                        (push "Start 2" list)
 515                        (tinydb-q-will-call tq nil
 516                           #'(lambda
 517                                (obj x)
 518                                (sleep-for 0.2)
 519                                (throw 'tinydb-q-new-obj
 520                                   (cons x obj)))
 521                           arg))
 522                   1728)
 523                (sit-for 0.6)
 524                (tinydb-q-do-pending tq)
 525                (push "End test" list)
 526                (assert
 527                   (equal
 528                      (reverse list)
 529                      '("Start test" "Start 1" "Start 2" "End 1" "End test"))
 530                   t)
 531                (assert
 532                   (rtest:sets=
 533                      (tinydb-q->obj tq)
 534                      '(1728 12 144))
 535                   t)
 536                t)))))
 537
 538
 539
 540 ;;;_. Footers
 541 ;;;_ , Provides
 542
 543 (provide 'tinydb/persist/tests)
 544
 545 ;;;_ * Local emacs vars.
 546 ;;;_  + Local variables:
 547 ;;;_  + mode: allout
 548 ;;;_  + End:
 549
 550 ;;;_ , End
 551 ;;; tinydb/persist/tests.el ends here