summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2021-01-08 12:54:26 +0100
committerpukkamustard <pukkamustard@posteo.net>2021-01-08 12:54:26 +0100
commit1d7ec31b14a60b73339341bc34ee356d7e5d638d (patch)
tree9635e70ab5638497b203392aed1c99bd9e44688d
parentccf94fc2ca2e4917c9731f2ea464f4d9a63f0439 (diff)
(tests lmdb low-level): initial tests for the low-level bindings
-rw-r--r--Makefile.am2
-rw-r--r--hall.scm4
-rw-r--r--lmdb.scm2
-rw-r--r--lmdb/low-level.scm204
-rw-r--r--tests/lmdb/low-level.scm149
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")