whiteline
/
kekkonen
1
0
Fork 0
Code Issues 0 Pull Requests 0 Releases 0 Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
34 Commits
1 Branch
156KB
Branch: master
Branches Tags
${ item.name }
Create branch ${ searchTerm }
from 'master'
${ noResults }
kekkonen/test-database.scm

49 lines
1.7KB
Raw Permalink Blame History 

  1. (module test-database ()

  2.   (import scheme)

  3.   (import (chicken base))

  4.   (import (chicken syntax))

  5.   (import test)

  6.   (import database)

  7. 

  8.   (test-group "database"

  9. 	      (test '((test . ((test-key . 3)))) (begin (database-null)

  10. 							(database-set 'test 'test-key 3)

  11. 							*database*))

  12. 	      (test 3 (begin (database-null)

  13. 			     (database-set 'test 'test-key 3)

  14. 			     (database-get 'test 'test-key #f)))

  15. 	      (test '((test . ((test-key . 3)))) (begin (database-null)

  16. 							(database-set 'test 'test-key 3)

  17. 							(database-save "test.sav")

  18. 							(database-null)

  19. 							(database-load "test.sav")))

  20. 	      (test '() (begin (database-null)

  21. 			       (database-set 'test 'test-key 3)

  22. 			       (database-remove 'test)

  23. 			       *database*))

  24. 	      (test '(test) (begin (database-null)

  25. 				   (database-set 'test 'test-key 3)

  26. 				   (get-all-objects)))

  27. 	      (test-group "object-exists?"

  28. 			  (test #t (begin (database-null)

  29. 					  (database-set 'test 'test-key 3)

  30. 					  (object-exists? 'test)))

  31. 			  (test #f (begin (database-null)

  32. 					  (object-exists? 'test))))

  33. 	      (test-group "has-property?"

  34. 			  (test #t (begin (database-null)

  35. 					  (database-set 'test 'test-key 3)

  36. 					  (has-property? 'test 'test-key)))

  37. 			  (test #f (begin (database-null)

  38. 					  (database-set 'test 'test-key 3)

  39. 					  (has-property? 'test 'nosuch-key))))

  40. 	      (test-group "toggle-flag"

  41. 			  (test #t (begin (database-null)

  42. 					  (database-set 'test 'test-key #f)

  43. 					  (toggle-flag 'test 'test-key)

  44. 					  (database-get 'test 'test-key #f)))

  45. 			  (test #f (begin (database-null)

  46. 					  (database-set 'test 'test-key #t)

  47. 					  (toggle-flag 'test 'test-key)

  48. 					  (database-get 'test 'test-key #t))))))