...
 
Commits (5)
......@@ -80,7 +80,7 @@
(format #t "*** Computed: ~s\n" produced))))))))
(define-macro (test-end)
'(if (eq? (pk %failed) 0)
'(if (eq? %failed 0)
(exit 0)
(exit -1)))
......
......@@ -2,6 +2,7 @@
(use-modules (tests helpers))
(use-modules (wiredtiger wiredtiger))
(use-modules (rnrs bytevectors))
(setlocale LC_ALL "")
......@@ -29,7 +30,7 @@
(cursor-next index)
(with-cnx cnx
(list (call-with-values (lambda () (cursor-key-ref index)) list)
(call-with-values (lambda () (cursor-value-ref index)) list) )))))
(call-with-values (lambda () (cursor-value-ref index)) list) )))))
(list (list "a" "b") (list 42)))
(test-check "cursor search on empty table"
......@@ -41,7 +42,7 @@
(let ((cursor (cursor-open session "table:nodes" "")))
(cursor-key-set cursor 42)
(with-cnx cnx
(cursor-search cursor))))
(cursor-search cursor))))
-31803)
(test-check "cursor search"
......@@ -56,7 +57,7 @@
(cursor-insert cursor)
(cursor-key-set cursor 42)
(with-cnx cnx
(cursor-search cursor))))
(cursor-search cursor))))
0)
(test-check "cursor search near on empty table"
......@@ -149,8 +150,21 @@
(cursor-value-set cursor "timesink")
(cursor-insert cursor)
(with-cnx cnx
(cursor-key-ref cursor))))
(cursor-key-ref cursor))))
1)
(test-check "insert and retrieve bytevector"
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx "")))
(session-create session "table:terms" "key_format=r,value_format=u")
(let ((cursor (cursor-open session "table:terms" "append")))
(cursor-value-set cursor #vu8(41 42 43))
(cursor-insert cursor)
(cursor-key-set cursor 1)
(cursor-search cursor)
(with-cnx cnx
(bytevector->u8-list (cursor-value-ref cursor)))))
'(41 42 43))
(test-end)
......@@ -80,10 +80,20 @@
(define (check code)
(unless (eq? code 0)
(throw 'wiredtiger code)))
(throw 'wiredtiger code)))
(define-public %key-not-found -31803)
;;; wt_item
(define %item
(bs:struct
`((data ,uintptr_t)
(size ,uint32)
(mem ,uintptr_t)
(memsize ,size_t)
(flags ,uint32))))
;;;
;;; Connection
;;;
......@@ -115,8 +125,8 @@
(let ((function (wiredtiger ffi:int "wiredtiger_open" POINTER POINTER POINTER POINTER)))
(lambda (home config)
(let ((double-pointer (make-double-pointer)))
(check (function (ffi:string->pointer home) NULL (ffi:string->pointer config) double-pointer))
(pointer->bytestructure %connection (ffi:dereference-pointer double-pointer))))))
(check (function (ffi:string->pointer home) NULL (ffi:string->pointer config) double-pointer))
(pointer->bytestructure %connection (ffi:dereference-pointer double-pointer))))))
(define-public (connection-close connection config)
"Close CONNECTION. Any open sessions or cursors will be closed. CONFIG
......@@ -269,10 +279,10 @@ garbage collector."
(let loop ()
(let ((cursor (cursor-guardian)))
(when cursor
;; close the cursor unless it was already closed
(unless (eq? (bytestructure-ref* cursor 'key-format) NULL)
(cursor-close cursor))
(loop)))))
;; close the cursor unless it was already closed
(unless (eq? (bytestructure-ref* cursor 'key-format) NULL)
(cursor-close cursor))
(loop)))))
(add-hook! after-gc-hook reap-cursors)
......@@ -292,20 +302,23 @@ garbage collector."
(define (item->unsigned-64 double-pointer)
(u64vector-ref (ffi:pointer->bytevector double-pointer 8) 0))
(define (item->bytevector double-pointer)
(let ((item (pointer->bytestructure %item double-pointer)))
(ffi:pointer->bytevector (bytestructure-ref* item 'data)
(bytestructure-ref item 'size))))
(define %char->type-ref `((#\S . ,item->string)
(#\Q . ,item->unsigned-64)
(#\r . ,item->unsigned-64)))
(#\r . ,item->unsigned-64)
(#\u . ,item->bytevector)))
(define (pointers->scm formats pointers)
(pk formats pointers)
(let loop ((formats (string->list formats))
(pointers pointers)
(out '()))
(pointers pointers))
(if (null? formats)
(apply values out)
(loop (cdr formats)
(cdr pointers)
(append out (list ((assoc-ref %char->type-ref (car formats)) (car pointers))))))))
'()
(cons ((assoc-ref %char->type-ref (car formats)) (car pointers))
(loop (cdr formats) (cdr pointers))))))
(define-public (cursor-key-ref cursor)
"Retrieve the current key"
......@@ -315,7 +328,7 @@ garbage collector."
(signature (map (lambda _ POINTER) args*))
(function (ffi:pointer->procedure ffi:int (bytestructure-ref* cursor 'get-key) signature)))
(check (apply function args*))
(pointers->scm format args))))
(apply values (pointers->scm format args)))))
(define-public (cursor-value-ref cursor)
"Retrieve the current value"
......@@ -325,25 +338,33 @@ garbage collector."
(signature (map (lambda _ POINTER) args*))
(function (ffi:pointer->procedure ffi:int (bytestructure-ref* cursor 'get-value) signature)))
(check (apply function args*))
(pointers->scm format args))))
(apply values (pointers->scm format args)))))
;; set
(define (make-string-pointer string)
(ffi:bytevector->pointer (string->bytevector (string-append string "\0") "utf-8")))
(define (bytevector->item bv)
(let ((item (bytestructure %item)))
(bytestructure-set! item 'data (ffi:pointer-address (ffi:bytevector->pointer bv)))
(bytestructure-set! item 'size (bytevector-length bv))
(bytestructure->pointer item)))
(define *format->pointer* `((#\S . ,make-string-pointer)
(#\Q . ,ffi:make-pointer)))
(#\Q . ,ffi:make-pointer)
(#\r . ,ffi:make-pointer)
(#\u . ,bytevector->item)))
(define (formats->items formats values)
(let loop ((formats (string->list formats))
(values values)
(out '()))
(values values))
(if (null? formats)
out
(loop (cdr formats)
(cdr values)
(append out (list ((assoc-ref *format->pointer* (car formats)) (car values))))))))
'()
(cons ((assoc-ref *format->pointer* (car formats)) (car values))
(loop (cdr formats)
(cdr values))))))
(define-public (cursor-key-set cursor . key)
"Set the key for the next operation. If an error occurs during this operation,
......