summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorpukkamustard <pukkamustard@posteo.net>2021-01-12 09:20:58 +0100
committerpukkamustard <pukkamustard@posteo.net>2021-01-12 09:20:58 +0100
commit55944bb4bd6535936ab8c939ae10da196779d1c7 (patch)
tree66a4794e39231383c241b758eb257d93e7a3e38f
parentd4f99186a3f5d9d66b1d6d12d74c9bc8f66c33ad (diff)
(lmdb low-level): Wrap dbi as <mdb-dbi> record
-rw-r--r--lmdb/low-level.scm20
-rw-r--r--tests/lmdb/low-level.scm2
2 files changed, 14 insertions, 8 deletions
diff --git a/lmdb/low-level.scm b/lmdb/low-level.scm
index e691a8b..eac7ef7 100644
--- a/lmdb/low-level.scm
+++ b/lmdb/low-level.scm
@@ -7,6 +7,7 @@
#:use-module (ice-9 format)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -248,6 +249,11 @@
;; MDB_dbi
+(define-record-type <mdb-dbi>
+ (wrap-mdb-dbi value)
+ mdb-dbi?
+ (value unwrap-mdb-dbi))
+
(define* (mdb-dbi-open txn #:key (name #f) (flags 0))
(let* ((proc (liblmdb-func "mdb_dbi_open"
(list
@@ -277,8 +283,8 @@
dbi-ptr)))
(if (eqv? return-value MDB_SUCCESS)
- ;; dbi is an unsigned integer
- (pointer-address (dereference-pointer dbi-ptr))
+ ;; wrap dbi as <mdb-dbi>
+ (wrap-mdb-dbi (pointer-address (dereference-pointer dbi-ptr)))
return-value)))
;; Database flags
@@ -327,7 +333,7 @@
;; unsigned int flags
unsigned-int))))
(proc (unwrap-mdb-txn txn)
- dbi
+ (unwrap-mdb-dbi dbi)
(unwrap-mdb-val key)
(unwrap-mdb-val data)
0)))
@@ -347,7 +353,7 @@
(data-ptr (bytevector->pointer
(make-bytevector (sizeof '*))))
(return-value (proc (unwrap-mdb-txn txn)
- dbi
+ (unwrap-mdb-dbi dbi)
(unwrap-mdb-val key)
data-ptr)))
(if (eqv? 0 return-value)
@@ -369,7 +375,7 @@
;; MDB_val* data
'*))))
(proc (unwrap-mdb-txn txn)
- dbi
+ (unwrap-mdb-dbi dbi)
(unwrap-mdb-val key)
(make-pointer 0))))
@@ -416,7 +422,7 @@
(cursor-ptr (bytevector->pointer
(make-bytevector (sizeof '*)))))
(proc (unwrap-mdb-txn txn)
- dbi
+ (unwrap-mdb-dbi dbi)
cursor-ptr)
(wrap-mdb-cursor (dereference-pointer cursor-ptr))))
@@ -496,7 +502,7 @@
;; const MDB_val* b
'*))))
(proc (unwrap-mdb-txn txn)
- dbi
+ (unwrap-mdb-dbi dbi)
(unwrap-mdb-val a)
(unwrap-mdb-val b))))
diff --git a/tests/lmdb/low-level.scm b/tests/lmdb/low-level.scm
index ae584f3..c54426f 100644
--- a/tests/lmdb/low-level.scm
+++ b/tests/lmdb/low-level.scm
@@ -31,7 +31,7 @@
(test-assert (mdb-txn? txn))
(define dbi (mdb-dbi-open txn))
-(test-assert (integer? dbi))
+(test-assert (mdb-dbi? dbi))
;; Commit the initial transaction
(test-eqv MDB_SUCCESS (mdb-txn-commit txn))