kekkonen/test-database.scm

(module test-database ()
  (import scheme)
  (import (chicken base))
  (import (chicken syntax))
  (import test)
  (import database)

  (test-group "database"
	      (test '((test . ((test-key . 3)))) (begin (database-null)
							(database-set 'test 'test-key 3)
							*database*))
	      (test 3 (begin (database-null)
			     (database-set 'test 'test-key 3)
			     (database-get 'test 'test-key #f)))
	      (test '((test . ((test-key . 3)))) (begin (database-null)
							(database-set 'test 'test-key 3)
							(database-save "test.sav")
							(database-null)
							(database-load "test.sav")))
	      (test '() (begin (database-null)
			       (database-set 'test 'test-key 3)
			       (database-remove 'test)
			       *database*))
	      (test '(test) (begin (database-null)
				   (database-set 'test 'test-key 3)
				   (get-all-objects)))
	      (test-group "object-exists?"
			  (test #t (begin (database-null)
					  (database-set 'test 'test-key 3)
					  (object-exists? 'test)))
			  (test #f (begin (database-null)
					  (object-exists? 'test))))
	      (test-group "has-property?"
			  (test #t (begin (database-null)
					  (database-set 'test 'test-key 3)
					  (has-property? 'test 'test-key)))
			  (test #f (begin (database-null)
					  (database-set 'test 'test-key 3)
					  (has-property? 'test 'nosuch-key))))
	      (test-group "toggle-flag"
			  (test #t (begin (database-null)
					  (database-set 'test 'test-key #f)
					  (toggle-flag 'test 'test-key)
					  (database-get 'test 'test-key #f)))
			  (test #f (begin (database-null)
					  (database-set 'test 'test-key #t)
					  (toggle-flag 'test 'test-key)
					  (database-get 'test 'test-key #t))))))