(tests lmdb low-level): initial tests for the low-level bindings

5 files changed, 256 insertions, 105 deletions

diff --git a/Makefile.am b/Makefile.am
index 64ca8a7..0947327 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -38,7 +38,7 @@ SOURCES = lmdb.scm \
           lmdb/internal.scm \
           lmdb/low-level.scm
 
-TESTS = 
+TESTS = tests/lmdb/low-level.scm
 
 TEST_EXTENSIONS = .scm
 SCM_LOG_DRIVER =                                \
diff --git a/hall.scm b/hall.scm
index 3d8c9ed..fcc7ccf 100644
--- a/hall.scm
+++ b/hall.scm
@@ -13,7 +13,9 @@
          ((scheme-file "lmdb")
           (directory "lmdb" ((scheme-file "internal")
                              (scheme-file "low-level")))))
-        (tests ((directory "tests" ())))
+        (tests
+         ((directory "tests"
+                     ((directory "lmdb" ((scheme-file "low-level")))))))
         (programs ((directory "scripts" ())))
         (documentation
          ((org-file "README")
diff --git a/lmdb.scm b/lmdb.scm
index 1adda34..ebb3981 100644
--- a/lmdb.scm
+++ b/lmdb.scm
@@ -80,7 +80,7 @@
                        (lambda (txn) (mdb-put txn (lmdb-db-dbi db)
                                               (make-mdb-val key)
                                               (make-mdb-val value))))
-    ((MDB_SUCCESS) #t)
+    ((0) #t)
     (else => raise-lmdb-error)))
 
 (define (lmdb-get db key)
diff --git a/lmdb/low-level.scm b/lmdb/low-level.scm
index daede93..3bd1b19 100644
--- a/lmdb/low-level.scm
+++ b/lmdb/low-level.scm
@@ -128,13 +128,15 @@
 
 (define (mdb-env-create)
   "Create an LMDB environment handle"
-  (let ((proc (liblmdb-func "mdb_env_create" (list '*)))
-        (mdb-env-ptr (bytevector->pointer
-                      (make-bytevector (sizeof '*) 0))))
-    ;; call mdb_env_create
-    (proc mdb-env-ptr)
-    ;; wrap returned pointer as <mdb-env>
-    (wrap-mdb-env (dereference-pointer mdb-env-ptr))))
+  (let* ((proc (liblmdb-func "mdb_env_create" (list '*)))
+         (mdb-env-ptr (bytevector->pointer
+                       (make-bytevector (sizeof '*) 0)))
+         ;; call mdb_env_create
+         (return-value (proc mdb-env-ptr)))
+    (if (eqv? return-value MDB_SUCCESS)
+        ;; wrap returned pointer as <mdb-env>
+        (wrap-mdb-env (dereference-pointer mdb-env-ptr))
+        return-value)))
 
 (define (mdb-env-open mdb-env path)
   "Open an environment handle"
@@ -166,31 +168,31 @@
 
 (define (mdb-txn-begin env)
   "Create a transaction for use with the environment"
-  (let ((proc (liblmdb-func "mdb_txn_begin"
-                            (list
-                             ;; MDB_env* env
-                             '*
-                             ;; MDB_txn* parent
-                             '*
-                             ;; unsigned int flags
-                             unsigned-int
-                             ;; MDB_txn** txn
-                             '*)))
-
-        ;; allocate a new pointer for returned txn
-        (txn-ptr (bytevector->pointer
-                  (make-bytevector (sizeof '*)))))
-
-    ;; call mdb_txn_begin
-    (proc (unwrap-mdb-env env)
-          ;; TODO allow specifying parent txn
-          (make-pointer 0)
-          0
-          txn-ptr)
-
-    ;; wrap pointer as <mdb-txn>
-    (wrap-mdb-txn (dereference-pointer txn-ptr))))
-
+  (let* ((proc (liblmdb-func "mdb_txn_begin"
+                             (list
+                              ;; MDB_env* env
+                              '*
+                              ;; MDB_txn* parent
+                              '*
+                              ;; unsigned int flags
+                              unsigned-int
+                              ;; MDB_txn** txn
+                              '*)))
+
+         ;; allocate a new pointer for returned txn
+         (txn-ptr (bytevector->pointer
+                   (make-bytevector (sizeof '*))))
+         ;; call mdb_txn_begin
+         (return-value (proc (unwrap-mdb-env env)
+                             ;; TODO allow specifying parent txn
+                             (make-pointer 0)
+                             0
+                             txn-ptr)))
+
+    (if (eqv? return-value MDB_SUCCESS)
+        ;; wrap pointer as <mdb-txn>
+        (wrap-mdb-txn (dereference-pointer txn-ptr))
+        return-value)))
 
 (define (mdb-txn-abort txn)
   "Abandon all the operations of the transaction instead of saving them"
@@ -205,27 +207,27 @@
 ;; MDB_dbi
 
 (define (mdb-dbi-open txn)
-  (let ((proc (liblmdb-func "mdb_dbi_open"
-                            (list
-                             ;; MDB_txn* txn
-                             '*
-                             ;; const char* name
-                             '*
-                             ;; unsigned int flags
-                             unsigned-int
-                             ;; MDB_dbi* dbi
-                             '*)))
-        (dbi-ptr (bytevector->pointer
-                  (make-bytevector (sizeof '*)))))
-    (proc (unwrap-mdb-txn txn)
-          ;; null pointer TODO allow specifying name
-          (make-pointer 0)
-          0
-          dbi-ptr)
-    ;; dbi is an unsigned integer
-    (pointer-address (dereference-pointer dbi-ptr))))
-
-
+  (let* ((proc (liblmdb-func "mdb_dbi_open"
+                             (list
+                              ;; MDB_txn* txn
+                              '*
+                              ;; const char* name
+                              '*
+                              ;; unsigned int flags
+                              unsigned-int
+                              ;; MDB_dbi* dbi
+                              '*)))
+         (dbi-ptr (bytevector->pointer
+                   (make-bytevector (sizeof '*))))
+         (return-value (proc (unwrap-mdb-txn txn)
+                             ;; null pointer TODO allow specifying name
+                             (make-pointer 0)
+                             0
+                             dbi-ptr)))
+    (if (eqv? return-value MDB_SUCCESS)
+        ;; dbi is an unsigned integer
+        (pointer-address (dereference-pointer dbi-ptr))
+        return-value)))
 
 ;; MDB_val
 
@@ -270,27 +272,27 @@
 
 (define (mdb-get txn dbi key)
   "Store items into a database."
-  (let ((proc (liblmdb-func "mdb_get"
-                            (list
-                             ;; MDB_txn* txn
-                             '*
-                             ;; MDB_dbi dbi
-                             unsigned-int
-                             ;; MDB_val* key
-                             '*
-                             ;; MDB_val* data
-                             '*)))
-        (data-ptr (bytevector->pointer
-                   (make-bytevector (sizeof '*)))))
-    (let ((return-value (proc (unwrap-mdb-txn txn)
-                              dbi
-                              (unwrap-mdb-val key)
-                              data-ptr)))
-      (if (eqv? 0 return-value)
-          ;; wrap data as <mdb-val>
-          (wrap-mdb-val data-ptr)
-          ;; else return the return value
-          return-value))))
+  (let* ((proc (liblmdb-func "mdb_get"
+                             (list
+                              ;; MDB_txn* txn
+                              '*
+                              ;; MDB_dbi dbi
+                              unsigned-int
+                              ;; MDB_val* key
+                              '*
+                              ;; MDB_val* data
+                              '*)))
+         (data-ptr (bytevector->pointer
+                    (make-bytevector (sizeof '*))))
+         (return-value (proc (unwrap-mdb-txn txn)
+                             dbi
+                             (unwrap-mdb-val key)
+                             data-ptr)))
+    (if (eqv? 0 return-value)
+        ;; wrap data as <mdb-val>
+        (wrap-mdb-val data-ptr)
+        ;; else return the return value
+        return-value)))
 
 (define (mdb-del txn dbi key)
   "Delete items from a database"
@@ -366,30 +368,31 @@
 
 (define (mdb-cursor-get cursor op)
   "Retrieve by cursor"
-  (let ((proc (liblmdb-func "mdb_cursor_get"
-                            (list
-                             ;; MDB_cursor* cursor
-                             '*
-                             ;; MDB_val* key
-                             '*
-                             ;; MDB_val* data
-                             '*
-                             ;; MDB_cursor_op op
-                             unsigned-int)))
-        (key-ptr (bytevector->pointer
-                  (make-bytevector (sizeof '*))))
-        (data-ptr (bytevector->pointer
-                   (make-bytevector (sizeof '*)))))
-
-    ;; call mdb_cursor_get
-    (proc (unwrap-mdb-cursor cursor)
-          key-ptr
-          data-ptr
-          op)
-
-    ;; wrap key and data as <mdb-val>
-    (values (wrap-mdb-val key-ptr)
-            (wrap-mdb-val data-ptr))))
+  (let* ((proc (liblmdb-func "mdb_cursor_get"
+                             (list
+                              ;; MDB_cursor* cursor
+                              '*
+                              ;; MDB_val* key
+                              '*
+                              ;; MDB_val* data
+                              '*
+                              ;; MDB_cursor_op op
+                              unsigned-int)))
+         (key-ptr (bytevector->pointer
+                   (make-bytevector (sizeof '*))))
+         (data-ptr (bytevector->pointer
+                    (make-bytevector (sizeof '*))))
+         ;; call mdb_cursor_get
+         (return-value (proc (unwrap-mdb-cursor cursor)
+                             key-ptr
+                             data-ptr
+                             op)))
+
+    (if (eqv? MDB_SUCCESS return-value)
+        ;; wrap key and data as <mdb-val>
+        (cons (wrap-mdb-val key-ptr)
+              (wrap-mdb-val data-ptr))
+        return-value)))
 
 (define (mdb-cursor-set cursor key op)
   "Retrieve by cursor with MDB_SET* operation that requires a key to be specified"
@@ -410,10 +413,7 @@
     (proc (unwrap-mdb-cursor cursor)
           (unwrap-mdb-val key)
           data-ptr
-          op)
-
-    ;; wrap data as <mdb-val>
-    (wrap-mdb-val data-ptr)))
+          op)))
 
 ;; (define env (mdb-env-create))
 
diff --git a/tests/lmdb/low-level.scm b/tests/lmdb/low-level.scm
new file mode 100644
index 0000000..1a079e7
--- /dev/null
+++ b/tests/lmdb/low-level.scm
@@ -0,0 +1,149 @@
+; SPDX-FileCopyrightText: 2021 pukkamustard <pukkamustard@posteo.net>
+;
+; SPDX-License-Identifier: GPL-3.0-or-later
+
+(define-module (tests lmdb low-level)
+
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-64)
+
+  #:use-module (lmdb low-level))
+
+(test-begin "low-level LMDB bindings")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Setup
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Create an LMDB environment handle
+(define env (mdb-env-create))
+(test-assert (mdb-env? env))
+
+;; Create a temporary directory
+(define db-dir (tmpnam))
+(mkdir db-dir)
+
+;; Open an environment handle
+(test-eqv MDB_SUCCESS (mdb-env-open env db-dir))
+
+;; Create an initial transaction and open a database
+(define txn (mdb-txn-begin env))
+(test-assert (mdb-txn? txn))
+
+(define dbi (mdb-dbi-open txn))
+(test-assert (integer? dbi))
+
+;; Commit the initial transaction
+(test-eqv MDB_SUCCESS (mdb-txn-commit txn))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Put, get and delete
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Put
+
+;; Begin a new transaction
+(define txn (mdb-txn-begin env))
+(test-assert (mdb-txn? txn))
+
+;; Put a key-value
+(test-eqv MDB_SUCCESS (mdb-put txn dbi
+                               (make-mdb-val (string->utf8 "Hello"))
+                               (make-mdb-val (string->utf8 "LMDB!"))))
+
+;; Commit transaction
+(test-eqv MDB_SUCCESS (mdb-txn-commit txn))
+
+;; Get
+
+;; Begin a new transaction
+(define txn (mdb-txn-begin env))
+(test-assert (mdb-txn? txn))
+
+;; get a key-value
+(define value (mdb-get txn dbi
+                       (make-mdb-val (string->utf8 "Hello"))))
+(test-assert (mdb-val? value))
+
+(test-assert (equal? (utf8->string (mdb-val-data value))
+                     "LMDB!"))
+
+;; Get a non-existent value
+(test-eqv MDB_NOTFOUND (mdb-get txn dbi
+                                (make-mdb-val (string->utf8 "Hi"))))
+
+;; Abort transaction
+(mdb-txn-abort txn)
+
+;; Delete
+
+;; Begin a new transaction
+(define txn (mdb-txn-begin env))
+(test-assert (mdb-txn? txn))
+
+(test-eqv MDB_SUCCESS (mdb-del txn dbi
+                               (make-mdb-val (string->utf8 "Hello"))))
+
+;; Commit transaction
+(test-eqv MDB_SUCCESS (mdb-txn-commit txn))
+
+;; Begin a new transaction
+(define txn (mdb-txn-begin env))
+(test-assert (mdb-txn? txn))
+
+;; try and get deleted key-value
+(test-eqv MDB_NOTFOUND (mdb-get txn dbi
+                                (make-mdb-val (string->utf8 "Hello"))))
+
+;; Abort transaction
+(mdb-txn-abort txn)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Cursor
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Add a range of key-values
+
+;; Begin a new transaction
+(define txn (mdb-txn-begin env))
+(test-assert (mdb-txn? txn))
+
+(for-each
+ (lambda (i)
+   (test-eqv MDB_SUCCESS
+     (mdb-put txn dbi
+              (make-mdb-val (u8-list->bytevector (list 0 i)))
+              (make-mdb-val (make-bytevector 32 0)))))
+ (iota 255))
+
+;; Commit the transaction
+(test-eqv MDB_SUCCESS (mdb-txn-commit txn))
+
+;; Begin a new transaction
+(define txn (mdb-txn-begin env))
+(test-assert (mdb-txn? txn))
+
+;; Open a new cursor
+(define cursor (mdb-cursor-open txn dbi))
+(test-assert (mdb-cursor? cursor))
+
+(test-eqv 255 (let next ((count 0))
+                (let* ((key-value (mdb-cursor-get cursor MDB_NEXT)))
+                  (if (integer? key-value)
+                      count
+                      (next (1+ count))))))
+
+;; Abort transaction
+(mdb-txn-abort txn)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Close DB and clean up
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; close the environment
+(mdb-env-close env)
+
+;; clean up the directory
+(system (string-append "rm -rf " db-dir))
+
+(test-end "low-level LMDB bindings")