whiteline/kekkonen
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

database tests and comments

Browse Source
This commit is contained in:
Victor Fors 2021-11-29 16:04:23 +01:00
parent 610cfe6952
commit 30d293a574
1 changed files with 48 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
test-database.scm Normal file
View File

@ -0,0 +1,48 @@
(module test-database ()
(import scheme)
(import (chicken base))
(import (chicken syntax))
(import test)
(import database)
(test-group "database"
(test '((test . ((test-key . 3)))) (begin (set! *database* '())
(database-set 'test 'test-key 3)
*database*))
(test 3 (begin (set! *database* '())
(database-set 'test 'test-key 3)
(database-get 'test 'test-key #f)))
(test '((test . ((test-key . 3)))) (begin (set! *database* '())
(database-set 'test 'test-key 3)
(database-save "test.sav")
(set! *database* '())
(database-load "test.sav")))
(test '() (begin (set! *database* '())
(database-set 'test 'test-key 3)
(database-remove 'test)
*database*))
(test '(test) (begin (set! *database* '())
(database-set 'test 'test-key 3)
(get-all-objects)))
(test-group "object-exists?"
(test #t (begin (set! *database* '())
(database-set 'test 'test-key 3)
(object-exists? 'test)))
(test #f (begin (set! *database* '())
(object-exists? 'test))))
(test-group "has-property?"
(test #t (begin (set! *database* '())
(database-set 'test 'test-key 3)
(has-property? 'test 'test-key)))
(test #f (begin (set! *database* '())
(database-set 'test 'test-key 3)
(has-property? 'test 'nosuch-key))))
(test-group "toggle-flag"
(test #t (begin (set! *database* '())
(database-set 'test 'test-key #f)
(toggle-flag 'test 'test-key)
(database-get 'test 'test-key #f)))
(test #f (begin (set! *database* '())
(database-set 'test 'test-key #t)
(toggle-flag 'test 'test-key)
(database-get 'test 'test-key #t))))))