;;;
;;; Time-stamp: <2006-11-06 17:02:38 nhw>
;;;
;;; Copyright (C) by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:

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