|
|
|
@@ -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)))))) |
