;; -*- mode: Scheme; -*-
;;
;; This file is part of BerkeleyDB for CHICKEN
;; Copyright (c) 2011 by Thomas Chust.  All rights reserved.
;;
;; Permission is hereby granted, free of charge, to any person
;; obtaining a copy of this software and associated documentation
;; files (the Software), to deal in the Software without restriction,
;; including without limitation the rights to use, copy, modify,
;; merge, publish, distribute, sublicense, and/or sell copies of the
;; Software, and to permit persons to whom the Software is furnished
;; to do so, subject to the following conditions:
;; 
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;; 
;; THE SOFTWARE IS PROVIDED ASIS, WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.

(require-library
 numbers
 srfi-4 srfi-42 srfi-69 srfi-78 posix extras
 berkeley-db)

(import
 numbers
 srfi-4 srfi-42 srfi-69 srfi-78 posix extras
 berkeley-db-serialization berkeley-db)

;; Serialization tests

(define (serialize&deserialize v)
  (call-with-input-string
   (call-with-output-string
    (cut serialize v <>))
   deserialize))

(define-record-type foo
  (make-foo a b)
  foo?
  (a foo-a)
  (b foo-b))

(define-record-printer (foo v port)
  (fprintf port "(make-foo ~s ~s)" (foo-a v) (foo-b v)))

(check-ec (: v (list
		(void) #t #f #\x
		1 1.2 3/4 5+6i 3/8-9/7i 1.2+3.4i
		'foo "bar" (string->blob "baz")
		'(x 2 y) '#(u v w) '#u8(1 2 3) '#f64(1.2 3.4 5.6)
		(alist->hash-table '((x . 42) (y . (xyzzy "foo"))))
		(make-foo "field a" "field b")))
  (serialize&deserialize v) => v)

;; Database tests

(create-directory "test.db-env")
(check
 (database-environment?
  (open-database-environment
   "test.db-env" #:create #:memory-pool #:transactions))
 =>
 #t)

(define records
  (with-transaction
   (cut open-database "records.db" 'records #:create)))
(check
 (database? records) => #t)

(define records-a
  (with-transaction
   (cut open-database "records-a.db" 'b-tree #:create #:duplicates/sorted)))
(check
 (database? records-a) => #t)

(define notes
  (with-transaction
   (cut open-database "notes.db" 'b-tree #:create)))
(check
 (database? notes) => #t)

(database-associate
 records (lambda (k v) (foo-a v)) records-a notes
 #:cascade)

(define sample
  #f)

(with-transaction
 (lambda ()
   (database-set! notes 1 "the number one")
   (database-set! notes 2 "the number two")
   (database-set! records #f (make-foo 1 'blubb) #:append)
   (set! sample (database-set! records #f (make-foo 1 'blabb) #:append))
   (database-set! records #f (make-foo 2 'blargh) #:append)))

(define (count k v n)
  (add1 n))

(check
 (database-fold records count 0) => 3)

(check
 (database-fold records-a count 0 1) => 2)

(check
 (database-ref records sample) => (make-foo 1 'blabb))

(check
 (database-ref records-a 2) => (make-foo 2 'blargh))

(database-delete! notes 1)

(check
 (database-ref records-a 1 'fubar) => 'fubar)

(check
 (database-fold records (lambda (k v l) (cons v l)) '())
 =>
 (list (make-foo 2 'blargh)))

(cond-expand
 (enable-v5
  (close-database-environment #:synchronous))
 (else
  (close-database records)
  (close-database records-a)
  (close-database notes)
  (close-database-environment)))

(check-report)
(exit (if (check-passed? 11) 0 1))