(module database-test mzscheme
(require (planet "test.ss" ("schematics" "schemeunit.plt" 2))
(lib "serialize.ss"))
(require "base.ss"
"database.ss")
(provide database-tests)
(define (maybe-delete-test-db)
(when (file-exists? "test.db")
(delete-file "test.db")))
(define database-tests
(test-suite
"All tests for database"
(test-case
"Read and write invariant"
(around
(maybe-delete-test-db)
(let ((data (create-sample 'foo 1 2 3 4)))
(with-database
"test.db"
(lambda (db)
(write-sample db data)
(let ((samples
(read-samples db)))
(check-pred pair? samples)
(check = (length samples) 1)
(check-equal? (car samples) data)))))
(maybe-delete-test-db)))
(test-case
"Loading a non-db raises exn"
(around
(with-output-to-file "test.db"
(lambda () (write (serialize 'foo))))
(check-exn
exn:si?
(lambda ()
(with-database
"test.db"
(lambda (db) (fail "Exception not raised")))))
(maybe-delete-test-db)))
(test-case
"write-database overwrites existing database"
(around
(maybe-delete-test-db)
(with-database
"test.db"
(lambda (db)
(write-sample db
(create-sample 'test 1 1 1 1))))
(with-database
"test.db"
(lambda (db)
(write-sample db
(create-sample 'test 1 1 1 1))))
(with-database
"test.db"
(lambda (db)
(check = (length (read-samples db)) 2)))
(maybe-delete-test-db)))
(test-case
"delete-samples! removes all samples"
(around
(maybe-delete-test-db)
(with-database
"test.db"
(lambda (db)
(write-sample db (create-sample 'test 1 1 1 1))
(write-sample db (create-sample 'test 1 1 1 1))
(write-sample db (create-sample 'test 1 1 1 1))
(check = (length (read-samples db)) 3)
(delete-samples! db)
(check-pred null? (read-samples db))))
(maybe-delete-test-db)))
(test-case
"delete-samples! does nothing if there are no samples"
(around
(maybe-delete-test-db)
(with-database
"test.db"
(lambda (db)
(check-pred null? (read-samples db))
(delete-samples! db)
(check-pred null? (read-samples db))))
(maybe-delete-test-db)))
(test-case
"delete-samples! writes results"
(around
(maybe-delete-test-db)
(with-database
"test.db"
(lambda (db)
(write-sample db (create-sample 'test 1 1 1 1))
(delete-samples! db)
(check-pred null? (read-samples db))))
(with-database
"test.db"
(lambda (db)
(check-pred null? (read-samples db))))
(maybe-delete-test-db)))
))
)