fix cursor-put: encode flags correctly

- turn-database-debugging-on
- turn-database-debugging-off
- set-database-env-verbose!
- database-env-verbose

AUTHORS

@@ -0,0 +1,2 @@
+Daniel Brintzinger
+Eric Knauel

COPYING

@@ -0,0 +1,26 @@
+Copyright (c) 2004 by Eric Knauel
+Copyright (c) 2004 by Daniel Brintzinger
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+3. The name of the authors may not be used to endorse or promote products
+   derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
+NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

INSTALL

@@ -0,0 +1,229 @@
+Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002 Free Software
+Foundation, Inc.
+
+   This file is free documentation; the Free Software Foundation gives
+unlimited permission to copy, distribute and modify it.
+
+Basic Installation
+==================
+
+   These are generic installation instructions.
+
+   The `configure' shell script attempts to guess correct values for
+various system-dependent variables used during compilation.  It uses
+those values to create a `Makefile' in each directory of the package.
+It may also create one or more `.h' files containing system-dependent
+definitions.  Finally, it creates a shell script `config.status' that
+you can run in the future to recreate the current configuration, and a
+file `config.log' containing compiler output (useful mainly for
+debugging `configure').
+
+   It can also use an optional file (typically called `config.cache'
+and enabled with `--cache-file=config.cache' or simply `-C') that saves
+the results of its tests to speed up reconfiguring.  (Caching is
+disabled by default to prevent problems with accidental use of stale
+cache files.)
+
+   If you need to do unusual things to compile the package, please try
+to figure out how `configure' could check whether to do them, and mail
+diffs or instructions to the address given in the `README' so they can
+be considered for the next release.  If you are using the cache, and at
+some point `config.cache' contains results you don't want to keep, you
+may remove or edit it.
+
+   The file `configure.ac' (or `configure.in') is used to create
+`configure' by a program called `autoconf'.  You only need
+`configure.ac' if you want to change it or regenerate `configure' using
+a newer version of `autoconf'.
+
+The simplest way to compile this package is:
+
+  1. `cd' to the directory containing the package's source code and type
+     `./configure' to configure the package for your system.  If you're
+     using `csh' on an old version of System V, you might need to type
+     `sh ./configure' instead to prevent `csh' from trying to execute
+     `configure' itself.
+
+     Running `configure' takes awhile.  While running, it prints some
+     messages telling which features it is checking for.
+
+  2. Type `make' to compile the package.
+
+  3. Optionally, type `make check' to run any self-tests that come with
+     the package.
+
+  4. Type `make install' to install the programs and any data files and
+     documentation.
+
+  5. You can remove the program binaries and object files from the
+     source code directory by typing `make clean'.  To also remove the
+     files that `configure' created (so you can compile the package for
+     a different kind of computer), type `make distclean'.  There is
+     also a `make maintainer-clean' target, but that is intended mainly
+     for the package's developers.  If you use it, you may have to get
+     all sorts of other programs in order to regenerate files that came
+     with the distribution.
+
+Compilers and Options
+=====================
+
+   Some systems require unusual options for compilation or linking that
+the `configure' script does not know about.  Run `./configure --help'
+for details on some of the pertinent environment variables.
+
+   You can give `configure' initial values for configuration parameters
+by setting variables in the command line or in the environment.  Here
+is an example:
+
+     ./configure CC=c89 CFLAGS=-O2 LIBS=-lposix
+
+   *Note Defining Variables::, for more details.
+
+Compiling For Multiple Architectures
+====================================
+
+   You can compile the package for more than one kind of computer at the
+same time, by placing the object files for each architecture in their
+own directory.  To do this, you must use a version of `make' that
+supports the `VPATH' variable, such as GNU `make'.  `cd' to the
+directory where you want the object files and executables to go and run
+the `configure' script.  `configure' automatically checks for the
+source code in the directory that `configure' is in and in `..'.
+
+   If you have to use a `make' that does not support the `VPATH'
+variable, you have to compile the package for one architecture at a
+time in the source code directory.  After you have installed the
+package for one architecture, use `make distclean' before reconfiguring
+for another architecture.
+
+Installation Names
+==================
+
+   By default, `make install' will install the package's files in
+`/usr/local/bin', `/usr/local/man', etc.  You can specify an
+installation prefix other than `/usr/local' by giving `configure' the
+option `--prefix=PATH'.
+
+   You can specify separate installation prefixes for
+architecture-specific files and architecture-independent files.  If you
+give `configure' the option `--exec-prefix=PATH', the package will use
+PATH as the prefix for installing programs and libraries.
+Documentation and other data files will still use the regular prefix.
+
+   In addition, if you use an unusual directory layout you can give
+options like `--bindir=PATH' to specify different values for particular
+kinds of files.  Run `configure --help' for a list of the directories
+you can set and what kinds of files go in them.
+
+   If the package supports it, you can cause programs to be installed
+with an extra prefix or suffix on their names by giving `configure' the
+option `--program-prefix=PREFIX' or `--program-suffix=SUFFIX'.
+
+Optional Features
+=================
+
+   Some packages pay attention to `--enable-FEATURE' options to
+`configure', where FEATURE indicates an optional part of the package.
+They may also pay attention to `--with-PACKAGE' options, where PACKAGE
+is something like `gnu-as' or `x' (for the X Window System).  The
+`README' should mention any `--enable-' and `--with-' options that the
+package recognizes.
+
+   For packages that use the X Window System, `configure' can usually
+find the X include and library files automatically, but if it doesn't,
+you can use the `configure' options `--x-includes=DIR' and
+`--x-libraries=DIR' to specify their locations.
+
+Specifying the System Type
+==========================
+
+   There may be some features `configure' cannot figure out
+automatically, but needs to determine by the type of machine the package
+will run on.  Usually, assuming the package is built to be run on the
+_same_ architectures, `configure' can figure that out, but if it prints
+a message saying it cannot guess the machine type, give it the
+`--build=TYPE' option.  TYPE can either be a short name for the system
+type, such as `sun4', or a canonical name which has the form:
+
+     CPU-COMPANY-SYSTEM
+
+where SYSTEM can have one of these forms:
+
+     OS KERNEL-OS
+
+   See the file `config.sub' for the possible values of each field.  If
+`config.sub' isn't included in this package, then this package doesn't
+need to know the machine type.
+
+   If you are _building_ compiler tools for cross-compiling, you should
+use the `--target=TYPE' option to select the type of system they will
+produce code for.
+
+   If you want to _use_ a cross compiler, that generates code for a
+platform different from the build platform, you should specify the
+"host" platform (i.e., that on which the generated programs will
+eventually be run) with `--host=TYPE'.
+
+Sharing Defaults
+================
+
+   If you want to set default values for `configure' scripts to share,
+you can create a site shell script called `config.site' that gives
+default values for variables like `CC', `cache_file', and `prefix'.
+`configure' looks for `PREFIX/share/config.site' if it exists, then
+`PREFIX/etc/config.site' if it exists.  Or, you can set the
+`CONFIG_SITE' environment variable to the location of the site script.
+A warning: not all `configure' scripts look for a site script.
+
+Defining Variables
+==================
+
+   Variables not defined in a site shell script can be set in the
+environment passed to `configure'.  However, some packages may run
+configure again during the build, and the customized values of these
+variables may be lost.  In order to avoid this problem, you should set
+them in the `configure' command line, using `VAR=value'.  For example:
+
+     ./configure CC=/usr/local2/bin/gcc
+
+will cause the specified gcc to be used as the C compiler (unless it is
+overridden in the site shell script).
+
+`configure' Invocation
+======================
+
+   `configure' recognizes the following options to control how it
+operates.
+
+`--help'
+`-h'
+     Print a summary of the options to `configure', and exit.
+
+`--version'
+`-V'
+     Print the version of Autoconf used to generate the `configure'
+     script, and exit.
+
+`--cache-file=FILE'
+     Enable the cache: use and save the results of the tests in FILE,
+     traditionally `config.cache'.  FILE defaults to `/dev/null' to
+     disable caching.
+
+`--config-cache'
+`-C'
+     Alias for `--cache-file=config.cache'.
+
+`--quiet'
+`--silent'
+`-q'
+     Do not print messages saying which checks are being made.  To
+     suppress all normal output, redirect it to `/dev/null' (any error
+     messages will still be shown).
+
+`--srcdir=DIR'
+     Look for the package's source code in directory DIR.  Usually
+     `configure' can determine that directory automatically.
+
+`configure' also accepts some other, not widely useful, options.  Run
+`configure --help' for more details.
+

Makefile.am

@@ -0,0 +1 @@
+SUBDIRS = c

c/Makefile.am

@@ -0,0 +1,8 @@
+INCLUDES = -I@top_srcdir@/c 
+
+libsys_LTLIBRARIES= libscshbdb.la
+
+libscshbdb_la_SOURCES=bdb.c
+libscshbdb_la_LDFLAGS=-avoid-version -module
+libscshbdb_la_DEPENDENCIES=
+

c/bdb.h

@@ -9,6 +9,7 @@
 /* record types */
 static s48_value bdb_db_record_type = S48_FALSE;
 static s48_value bdb_env_record_type = S48_FALSE;
+static s48_value bdb_lock_record_type = S48_FALSE;
 static s48_value bdb_mpoolfile_record_type = S48_FALSE;
 static s48_value bdb_txn_record_type = S48_FALSE;
 static s48_value bdb_dbc_record_type = S48_FALSE;
@@ -30,11 +31,20 @@ s48_value scsh_enter_dbenv(DB_ENV *h);
 #define scsh_extract_dbenv(x) \
         ((DB_ENV *) s48_extract_integer(S48_RECORD_REF(x, 0)))
 
+s48_value scsh_enter_lock(DB_LOCK *l);
+#define scsh_extract_lock(x) \
+	((DB_LOCK *) s48_extract_integer(S48_RECORD_REF(x, 0)))
+
+s48_value scsh_enter_DBT_as_bytevector(DBT* dt);
+void scsh_extract_bytevector_as_DBT(s48_value bytevector, DBT* dt);
+
 #define CHECK_BDB_RESULT_CODE(res)		\
 	do {					\
-	     if (res < 0)			\
+	     if (res != 0)			\
-               s48_raise_os_error(res);         \
+	       fprintf(stderr, "scsh-bdb: %s\n", db_strerror(res)); \	
 	     if (res > 0)			\
+               s48_raise_os_error(res);         \
+             if (res < 0)                       \
                return s48_enter_integer(res);   \
             } while (0);
 
@@ -46,3 +56,8 @@ s48_value scsh_enter_dbenv(DB_ENV *h);
 
 #define EXTRACT_OPTIONAL_ENV(env)		\
 	((env == S48_FALSE) ? NULL : scsh_extract_dbenv(env))
+
+#define ENTER_INTEGER_CONSTANT(scm_value, c_value)		\
+	S48_GC_PROTECT_GLOBAL(scm_value);			\
+	scm_value = s48_enter_integer(c_value);			\
+	s48_define_exported_binding(#scm_value, scm_value);

configure.in

@@ -0,0 +1,39 @@
+AC_INIT(c/bdb.c)
+AM_INIT_AUTOMAKE(scsh-bdb, 0.1)
+AM_CONFIG_HEADER(c/config.h)
+
+AC_ENABLE_SHARED
+AM_PROG_LIBTOOL
+
+AC_PROG_CC
+AC_STDC_HEADERS
+
+dnl scsh include path
+AC_ARG_WITH(scsh-includes, 
+            AC_HELP_STRING([--with-scsh-includes=DIR],  
+                           [scsh include files are in DIR [default is /usr/local/include]]),
+	                   scsh_includes=$withval, 
+		           scsh_includes=/usr/local/include)
+AC_SUBST(CFLAGS, "$CFLAGS -I${scsh_includes}")
+AC_SUBST(CPPFLAGS, "$CPPFLAGS -I${scsh_includes}")
+
+dnl Berkeley DB prefix
+AC_ARG_WITH(bdb-prefix,
+	    AC_HELP_STRING([--with-bdb-prefix=DIR],
+			   [Berkeley DB library and include have prefix DIR [default is /usr/local]]),
+	    [bdb_lib=$withval/lib bdb_include=$withval/include],
+	    [bdb_lib=/usr/local/lib bdb_include=/usr/local/include])
+AC_SUBST(LDFLAGS, "$LDFLAGS -L${bdb_lib} -ldb-4")
+AC_SUBST(CFLAGS, "$CFLAGS -I${bdb_include}")
+AC_SUBST(CPPFLAGS, "$CPPFLAGS -I${bdb_include}")
+
+schemedir='${prefix}'"/scheme"
+libdir='${prefix}'"/lib"
+libsysdir='${prefix}'
+
+AC_SUBST(libdir)
+AC_SUBST(libsysdir)
+AC_SUBST(schemedir)
+AC_SUBST(CC)
+AC_OUTPUT([Makefile c/Makefile])
+

pkg-def.scm

@@ -0,0 +1,74 @@
+(define-package "bdb" (0 1 0)
+  ((install-lib-version (1 0))
+   (options (bdb-prefix "Uses Berkeley DB library with prefix" "<dir>" #t #f #f)))
+
+  (define (display-bold text)
+    (display "\033[1m")
+    (display text)
+    (display "\033[m"))
+  
+  (newline)
+  (display-bold "Configuring, compiling and installing C-stubs")
+  (newline)
+
+  (let* ((scsh-includes (include-dir))
+	 (build-host (get-option-value 'build))
+	 (prefix (string-append (get-directory 'lib #f) "/" build-host))
+	 (configure (append
+		     (list "./configure"
+			   (string-append "--prefix=" prefix)
+			   (string-append "--with-scsh-includes=" scsh-includes)
+			   (string-append "--enable-static=no")
+			   (string-append "--build=" build-host))
+		     (cond ((get-option-value 'bdb-prefix)
+			    => (lambda (prefix)
+				 (list 
+				  (string-append "--with-bdb-prefix=" prefix))))
+			   (else '()))))
+	 (make `(make install
+		  ,(string-append "DESTDIR=" (get-option-value 'dest-dir)))))
+    (if (get-option-value 'dry-run)
+	(begin
+          (display configure) (newline)
+          (display make) (newline))
+	(if (not (and (zero? (run ,configure))
+		      (zero? (run ,make))))
+	    (exit))))
+  
+  (newline)
+  (display-bold "Creating load.scm")
+  (newline)
+
+  (let ((schemedir (get-directory 'scheme #f))
+	(libdir (get-directory 'lib #f)))
+    (write-to-load-script
+     `((user)
+       (load-package 'dynamic-externals)
+       (open 'dynamic-externals)
+       (open 'external-calls)
+       (open 'configure)
+       (open 'signals)
+       ,@(map (lambda (x) `(run ',x)) tmpl-libtool-la-reader)
+       (run '(let* ((lib-dir (string-append ,libdir "/" (host)))
+		    (la-file-name (string-append lib-dir "/libscshbdb.la"))
+		    (initializer-name "scsh_init_bdb_bindings"))
+	       (let ((la-alist (read-libtool-la la-file-name)))
+		 (cond
+		  ((assoc 'dlname la-alist)
+		   => (lambda (p)
+			(let ((module-file (string-append lib-dir "/" (cdr p))))
+			  (dynamic-load module-file)
+			  (call-external (get-external initializer-name)))))
+		  (else
+		   (error "Could not figure out libscshbdb's name" la-file-name))))))
+       (config)
+       (load ,(string-append schemedir "/packages.scm"))
+       (user))))
+
+  (newline)
+  (display-bold "Installing Scheme files")
+  (newline)
+
+  (install-directory-contents "scheme" 'scheme)
+  )
+

scheme/packages.scm

@@ -1,9 +1,28 @@
 (define-interface berkeley-db-interface
     (export
-     bdb-flags-object?
+
-     bdb-flags-elements
+     with-database-env
-     bdb-flags-name
+     with-database
-     (bdb-flags :syntax)
+     with-database-flags
+     as-transaction
+
+     berkeley-db-version
+     berkeley-db-version-string
+
+     flag-object?
+     flag-elements
+     flag-name
+     (flag :syntax)
+
+     lock-mode-object?
+     lock-mode-elements
+     lock-mode-name
+     (lock-mode :syntax)
+
+     return-code-object?
+     return-code-elements
+     return-code-name
+     (return-code :syntax)
 
      database-type-object?
      database-type-elements
@@ -18,35 +37,92 @@
      &bdb-secondary-index-bad bdb-secondary-index-bad?
      &bdb-invalid-flag bdb-invalid-flag?
 
-     bdb-db?
+     database?
-     bdb-env?
+     database-env?
-     bdb-mpoolfile?
+     mpoolfile?
-     bdb-txn?
+     transaction?
-     bdb-dbc?
+     cursor?
 
-     bdb-env-create
+     make-database-env
-     bdb-env-open
+     remove-database
-     bdb-env-close
+     remove-database/fork
-     ;bdb-env-remove
+     rename-database
+     rename-database/fork
+     database-env-open
+     set-database-env-data-dir!
+     database-env-data-dirs
+     set-database-env-encrypt!
+     database-env-encrypt-flags
+     set-database-env-verbose!
+     database-env-verbose
+     set-database-env-lock-timeout!
+     set-database-env-transaction-timeout!
+     database-env-lock-timeout
+     database-env-transaction-timeout
+     set-database-env-tmp-dir!
+     database-env-tmp-dir
+     set-database-env-max-transactions!
+     database-env-max-transactions
+     set-database-env-transaction-timeout!
+     database-env-transaction-timeout
+     set-database-env-flags!
+     clear-database-env-flags!
+     database-env-flags
+     database-env-close
+     database-env-fresh-locker-id
+     database-env-free-locker-id
+     database-env-get-lock
+     database-env-put-lock
+     set-database-env-transaction-checkpoint!
      
-     bdb-create
+     make-database
-     bdb-open
+     open-database
-     bdb-close
+     open-database/fork
-     bdb-put
+     close-database
-     bdb-get
+     database-put
-     bdb-del
+     database-put/fork
-     bdb-truncate
+     database-get
-     bdb-sync
+     database-get/fork
-     ;bdb-create-cursor
+     database-delete-item
-     ;bdb-cursor-cget
+     database-delete-item/fork
+     database-truncate
+     database-truncate/fork
+     database-sync
+     set-database-encrypt!
+     database-encrypt-flags
+     set-database-flags!
+     database-flags
+     turn-database-debugging-on
+     turn-database-debugging-off
+     set-database-byte-order!
+     database-big-endian?
+     database-little-endian?
+     set-database-page-size!
+     database-page-size
      
-     bdb-begin-transaction
+     make-cursor
-     bdb-abort-transaction
+     cursor-get
-     bdb-commit-transaction))
+     cursor-get/fork
+     cursor-count
+     cursor-delete-item
+     cursor-delete-item/fork
+     cursor-put
+     cursor-put/fork
+     
+     begin-transaction
+     abort-transaction
+     commit-transaction
+     
+     string->byte-vector
+     byte-vector->string
+     
+     value->byte-vector
+     byte-vector->value))
 
 (define-structure berkeley-db berkeley-db-interface
   (open scheme
 	srfi-1
+	srfi-8
 	srfi-34
 	srfi-35
 	fluids
@@ -58,6 +134,7 @@
 	bitwise
 	define-record-types
 	finite-types
-	external-calls)
+	external-calls
+	(subset scsh-level-0 (fork wait pipe)))
   (files bdb))
   

test/tests.scm

@@ -0,0 +1,390 @@
+#!/bin/sh
+exec scsh -lel exceptions/load.scm -lel bdb/load.scm -o berkeley-db -e main -s "$0" "$@"
+!#
+
+(define *tests* '())
+
+(define (test-dir)
+  "/tmp/bdb-test/")
+
+(define (add-test! name proc)
+  (set! *tests* (append *tests* (list (cons name proc)))))
+
+(define (make-empty-test-dir)
+  (if (file-exists? (test-dir))
+      (run (rm -rf ,(test-dir))))
+  (run (mkdir -p ,(test-dir))))
+
+(define (fail-if-error try-thunk else-thunk)
+  (and (call-with-current-continuation
+	(lambda (escape)
+	  (with-errno-handler*
+	   (lambda (errno packet)
+	     (escape #f))
+	   try-thunk)))
+       (else-thunk)))
+
+(add-test! 
+    "berkeley-db-version and berkeley-db-version-string"
+    (lambda ()
+      (let ((version (berkeley-db-version)))
+	(and (list? version) 
+	     (= 3 (length version))
+	     (string? (berkeley-db-version-string))))))
+
+(add-test! 
+    "make-database-env"
+    (lambda ()
+      (and (database-env? (make-database-env))
+	   (database-env? (make-database-env (flag rpc-client)))
+	   (database-env? (make-database-env (list (flag rpc-client)))))))
+
+;remove-database
+;remove-database*
+;rename-database
+;rename-database*
+
+'(add-test!
+    "database-env-open"
+    (lambda ()
+      (let ((env (make-database-env)))
+	(fail-if-error
+	 (lambda ()
+	   (database-env-open env (test-dir) 
+			      (list (flag truncate) (flag create))))
+	 (lambda () #t)))))
+
+(add-test!
+    "set/get database-env data-dirs"
+    (lambda ()
+      (let ((env (make-database-env))
+	    (dirs #f))
+	(fail-if-error
+	 (lambda ()
+	   (set-database-env-data-dir! env (test-dir))
+	   (set! dirs (database-env-data-dirs env)))
+	 (lambda () (equal? dirs (list (test-dir))))))))
+
+(add-test!
+    "set-database-env-encrypt!"
+    (lambda ()
+      (let ((env (make-database-env)))
+	(fail-if-error
+	 (lambda ()
+	   (set-database-env-encrypt! env "foo"))
+	 (lambda () #t)))))
+
+(add-test!
+    "database-env-encrypt-flags"
+    (lambda ()
+      (fail-if-error
+       (lambda ()
+	 (database-env-encrypt-flags (make-database-env)))
+       (lambda () #t))))
+
+(add-test!
+    "set-database-env-lock-timeout! and database-env-lock-timeout"
+    (lambda ()
+      (let ((env (make-database-env))
+	    (timeout #f))
+	(fail-if-error
+	 (lambda ()
+	   (set-database-env-lock-timeout! env 128)
+	   (set! timeout (database-env-lock-timeout env)))
+	 (lambda ()
+	   (equal? timeout 128))))))
+
+(add-test!
+    "set-database-env-transaction-timeout! and database-env-transaction-timeout"
+    (lambda ()
+      (let ((env (make-database-env))
+	    (timeout #f))
+	(fail-if-error
+	 (lambda ()
+	   (set-database-env-transaction-timeout! env 100)
+	   (set! timeout
+		 (database-env-transaction-timeout env)))
+	 (lambda ()
+	   (equal? timeout 100))))))
+
+(add-test!
+    "set-database-env-tmp-dir! and database-env-tmp-dir"
+    (lambda ()
+      (let ((env (make-database-env))
+	    (dir #f))
+	(fail-if-error
+	 (lambda ()
+	   (set-database-env-tmp-dir! env (test-dir))
+	   (set! dir (database-env-tmp-dir env)))
+	 (lambda ()
+	   (equal? dir (test-dir)))))))
+
+(add-test!
+    "set-database-env-max-transactions! and database-env-max-transactions"
+    (lambda ()
+      (let ((env (make-database-env))
+	    (max #f))
+	(fail-if-error
+	 (lambda ()
+	   (set-database-env-max-transactions! env 12)
+	   (set! max (database-env-max-transactions env)))
+	 (lambda ()
+	   (equal? max 12))))))
+
+(add-test!
+    "set-database-env-flags!, clear-database-env-flags! and database-env-flags"
+    (lambda ()
+      (let ((env (make-database-env))
+	    (f1 #f)
+	    (f2 #f)
+	    (f3 #f))
+	(fail-if-error
+	 (lambda ()
+	   (set! f1 (database-env-flags env))
+	   (set-database-env-flags! env (flag encrypt))
+	   (set! f2 (database-env-flags env))
+	   (clear-database-env-flags! env (flag encrypt))
+	   (set! f3 (database-env-flags env)))
+	 (lambda ()
+	   (and (= f1 f3) (not (= f1 f2))))))))
+
+(add-test!
+    "database-env-close"
+    (lambda ()
+      (fail-if-error
+       (lambda ()
+	 (database-env-close (make-database-env)))
+       (lambda () #t))))
+
+(add-test!
+    "database-env-fresh-locker-id"
+    (lambda ()
+      (let ((env (make-database-env))
+	    (id #f))
+	(fail-if-error
+	 (lambda ()
+	   (database-env-open env (test-dir)
+			      (list (flag init-lock) (flag create)))
+	   (set! id
+		 (database-env-fresh-locker-id env)))
+	 (lambda ()
+	   (integer? id))))))
+
+(add-test!
+    "database-env-free-locker-id"
+    (lambda ()
+      (let ((env (make-database-env)))
+	(fail-if-error
+	 (lambda ()
+	   (database-env-open env (test-dir)
+			      (list (flag init-lock) (flag create)))
+	   (database-env-free-locker-id 
+	    env
+	    (database-env-fresh-locker-id env))
+	   (database-env-close env))
+	 (lambda () #t)))))
+
+;database-env-get-lock
+;database-env-put-lock
+
+(add-test!
+    "set-database-env-transaction-checkpoint!"
+    (lambda ()
+      (let ((env (make-database-env)))
+	(fail-if-error
+	 (lambda ()
+	   (database-env-open env (test-dir)
+			      (list (flag init-transactions) (flag create)))
+	   (set-database-env-transaction-checkpoint! env 100 5)
+	   (database-env-close env))
+	 (lambda () #t)))))
+
+(add-test! 
+    "make-database"
+    (lambda ()
+      (let ((db1 #f)
+	    (db2 #f))
+	(fail-if-error
+	 (lambda ()
+	   (set! db1 (make-database))
+	   (set! db2 (make-database (make-database-env))))
+	 (lambda ()
+	   (and (database? db1) (database? db2)))))))
+
+(add-test!
+    "open-database"
+    (lambda ()
+      (fail-if-error
+       (lambda ()
+	 (open-database (make-database)
+			(string-append (test-dir) "/bla.db")
+			(database-type binary-tree)
+			(list (flag create) (flag truncate))))
+       (lambda () #t))))
+
+;open-database/fork
+
+(add-test!
+    "close-database"
+    (lambda ()
+      (fail-if-error
+       (lambda ()
+	 (let ((db (make-database)))
+	   (open-database db (string-append (test-dir) "/bla.db")
+			  (database-type binary-tree)
+			  (list (flag create) (flag truncate)))
+	   (close-database db)))
+       (lambda () #t))))
+
+(add-test!
+    "value->byte-vector and byte-vector->value"
+    (lambda ()
+      (let ((conv (lambda (v) 
+		    (byte-vector->value
+		     (value->byte-vector v)))))
+	(fold-right 
+	 (lambda (val res)
+	   (and res (equal? val (conv val))))
+	 #t
+	 '(42 42.0 (1 2 3) (1.0 2.0 3.0) ()
+	      "" "abc" #t #f abc
+	      #(vector 1 2 3) #())))))
+
+(add-test!
+    "string->byte-vector and byte-vector->string"
+    (lambda ()
+      (let ((conv (lambda (s)
+		    (byte-vector->string
+		     (string->byte-vector s)))))
+	(and (string=? "" (conv ""))
+	     (string=? "abc" (conv "abc"))))))
+
+(add-test!
+    "database-put and database-get"
+    (lambda ()
+      (let ((data #f)
+	    (key "donaudampfschifffahrtskapitaenanwaerter")
+	    (value "donaudampfschifffahrtskapitaenspatent"))
+	(fail-if-error
+	 (lambda ()
+	   (let ((db (make-database)))
+	     (open-database db (string-append (test-dir) "/bla.db")
+			    (database-type binary-tree)
+			    (list (flag create) (flag truncate)))
+	     (database-put db (string->byte-vector key)
+			   (string->byte-vector value))
+	     (set! data (database-get db (string->byte-vector key)))
+	     (close-database db)))
+	 (lambda ()
+	   (equal? (byte-vector->string data) value))))))
+
+(add-test!
+    "database-delete-item"
+    (lambda ()
+      (fail-if-error
+       (lambda ()
+	 (let ((db (make-database))
+	       (data (string->byte-vector "hm")))
+	   (open-database db (string-append (test-dir) "/bla.db")
+			  (database-type binary-tree)
+			  (list (flag create) (flag truncate)))
+	   (database-put db data data)
+	   (database-delete-item db data)
+	   (close-database db)))
+       (lambda () #t))))
+
+(add-test!
+    "database-truncate"
+    (lambda ()
+      (fail-if-error 
+       (lambda ()
+	 (let ((db (make-database)))
+	   (open-database db (string-append (test-dir) "/bla.db")
+			  (database-type binary-tree)
+			  (list (flag create) (flag truncate)))
+	   (database-truncate db)
+	   (close-database db)))
+       (lambda () #t))))
+
+(add-test!
+    "database-sync!"
+    (lambda ()
+      (fail-if-error 
+       (lambda ()
+	 (let ((db (make-database)))
+	   (open-database db (string-append (test-dir) "/bla.db")
+			  (database-type binary-tree)
+			  (list (flag create) (flag truncate)))
+	   (database-sync db)
+	   (close-database db)))
+       (lambda () #t))))
+
+(add-test!
+    "set-database-encrypt!"
+    (lambda ()
+      (fail-if-error
+       (lambda ()
+	 (set-database-encrypt! (make-database) "geheim"))
+       (lambda () #t))))
+
+(add-test!
+    "database-encrypt-flags"
+    (lambda ()
+      (let ((flags #f))
+	(fail-if-error
+	 (lambda ()
+	   (let ((db (make-database)))
+	     (open-database db (string-append (test-dir) "/bla.db")
+			    (database-type binary-tree)
+			    (list (flag create) (flag truncate)))
+	     (set! flags (database-encrypt-flags db))
+	     (close-database db)))
+	 (lambda () 
+	   (integer? flags))))))
+
+(add-test!
+    "set-database-flags!"
+    (lambda ()
+      (fail-if-error
+       (lambda ()
+	 (let ((db (make-database)))
+	   (open-database db (string-append (test-dir) "/bla.db")
+			  (database-type binary-tree)
+			  (list (flag create) (flag truncate)))
+	   (set-database-flags! db (flag checksum))
+	   (close-database db)))
+       (lambda () #t))))
+
+(add-test!
+    "database-flags"
+    (lambda ()
+      (let ((flags #f))
+	(fail-if-error
+	 (lambda ()
+	   (let ((db (make-database)))
+	     (open-database db (string-append (test-dir) "/bla.db")
+			    (database-type binary-tree)
+			    (list (flag create) (flag truncate)))
+	     (set! flags (database-flags db))
+	     (close-database db)))
+	 (lambda () 
+	   (integer? flags))))))
+
+(define (run-tests)
+  (make-empty-test-dir)
+  (let lp ((tests *tests*))
+    (if (null? tests)
+	(display "Finished.\n")
+	(begin
+	  (display "Testing ")
+	  (display (caar tests))
+	  (display "...")
+	  (if ((cdar tests))
+	      (begin
+		(display "ok\n")
+		(lp (cdr tests)))
+	      (display "failed\n"))))))
+
+(define (main args)
+  (run-tests))
+