...
 
Commits (2)
......@@ -2,6 +2,9 @@ include guile.am
TEST_EXTENSIONS = .scm
TESTS_UTILS = \
tests/helpers.scm
TESTS = tests/wiredtiger.scm \
tests/extra.scm \
tests/feature-space.scm \
......@@ -27,4 +30,6 @@ SOURCES = \
EXTRA_DIST = \
README.md \
bootstrap \
pre-inst-env.in
pre-inst-env.in \
$(TESTS) \
$(TESTS_UTILS)
AC_INIT([guile-wiredtiger], [0.6.2])
AC_INIT([guile-wiredtiger], [0.6.3])
AC_CONFIG_SRCDIR([wiredtiger])
AC_CONFIG_AUX_DIR([build-aux])
AC_CONFIG_MACRO_DIR([m4])
......@@ -17,7 +17,7 @@ PKG_PROG_PKG_CONFIG
PKG_CHECK_MODULES([WIREDTIGER],[wiredtiger],
[LIBWIREDTIGER_LIBDIR=`$PKG_CONFIG --variable=libdir wiredtiger`],
[LIBWIREDTIGER_LIBDIR="no"])
AC_ARG_WITH([libwiredtiger-prefix],
[AS_HELP_STRING([--with-libwiredtiger-prefix=DIR], [search for wiredtiger in DIR])],
[case "$withval" in
......
......@@ -55,14 +55,14 @@
(test-check "wiredtiger-open*"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((key . record)) ((value . integer)) ()))
(with-cnx cnx #true))
#true)
(test-check "cursor-insert* and cursor-search*"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(terms ((key . record)) ((value . unsigned-integer)) ()))
(with-cnx cnx
(let ((append (context-ref ctx 'terms-append)))
......@@ -72,7 +72,7 @@
3)
(test-check "cursor-range 0"
(receive (cnx ctx) (wiredtiger-open* "/tmp/wt" '(table ((k . record))
(receive (cnx ctx) (wiredtiger-open* "wt" '(table ((k . record))
((v . integer))
((reversed (v) (k)))))
(with-cnx cnx
......@@ -80,7 +80,7 @@
'())
(test-check "cursor-range 1"
(receive (cnx ctx) (wiredtiger-open* "/tmp/wt" '(table ((k . record))
(receive (cnx ctx) (wiredtiger-open* "wt" '(table ((k . record))
((v . integer))
((reversed (v) (k)))))
(cursor-insert* (context-ref ctx 'table-append) #nil '(1))
......@@ -93,7 +93,7 @@
'((4) (3) (2)))
(test-check "cursor-range 2"
(receive (cnx ctx) (wiredtiger-open* "/tmp/wt" '(table ((k . record))
(receive (cnx ctx) (wiredtiger-open* "wt" '(table ((k . record))
((v . integer))
((reversed (v) (k)))))
(cursor-insert* (context-ref ctx 'table-append) #nil '(1))
......@@ -103,7 +103,7 @@
'())
(test-check "cursor-range 3"
(receive (cnx ctx) (wiredtiger-open* "/tmp/wt" '(table ((k . record))
(receive (cnx ctx) (wiredtiger-open* "wt" '(table ((k . record))
((v . integer))
((reversed (v) (k)))))
(cursor-insert* (context-ref ctx 'table-append) #nil '(1))
......@@ -115,7 +115,7 @@
(test-check "cursor-range-prefix"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(let ((cursor (context-ref ctx 'table)))
(cursor-insert* cursor (list 0 0) (list 0))
......@@ -129,7 +129,7 @@
(test-check "cursor-range-prefix 2"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(let ((cursor (context-ref ctx 'table)))
(cursor-insert* cursor (list 1 1) (list 1))
......@@ -142,7 +142,7 @@
(test-check "cursor-range-prefix 3"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(let ((cursor (context-ref ctx 'table)))
(cursor-insert* cursor (list 2 0) (list 2))
......@@ -152,7 +152,7 @@
(test-check "cursor-range-prefix 3"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(let ((cursor (context-ref ctx 'table)))
(cursor-insert* cursor (list 0 0) (list 0))
......@@ -162,7 +162,7 @@
(test-check "cursor-range-prefix 4"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(let ((cursor (context-ref ctx 'table)))
(cursor-insert* cursor (list 0 0) (list 0))
......@@ -178,7 +178,7 @@
(test-check "cursor-range-prefix 5"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(let ((cursor (context-ref ctx 'table)))
(cursor-insert* cursor (list 0 0) (list 0))
......@@ -193,7 +193,7 @@
(test-check "cursor with empty range-prefix"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(let ((cursor (context-ref ctx 'table)))
(with-cnx cnx
......@@ -201,7 +201,7 @@
'())
(test-check "cursor-value-ref* on empty table"
(receive (cnx ctx)
(wiredtiger-open* "/tmp/wt"
(wiredtiger-open* "wt"
'(table ((a . integer) (b . integer)) ((c . integer)) ()))
(let ((cursor (context-ref ctx 'table)))
(with-cnx cnx
......@@ -213,7 +213,7 @@
#true)
(test-check "with-context"
(let ((env (env-open "/tmp/wt" "create")))
(let ((env (env-open "wt" "create")))
(env-config-add env '(counter ((name . string)) ((value . integer)) ()))
(env-create env)
(let ((cnx (env-connection env)))
......
......@@ -10,52 +10,52 @@
(test-begin)
(test-check "open feature-space database"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
42)
42)
(test-check "fs:find"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(fs:add! '((a . 42) (b . 1337)))
(fs:add! '((a . 0) (c . 1337)))
(length (fs:find 'b 1337)))
1)
(test-check "fs:remove!"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(fs:remove! (fs:add! '((a . 42) (b . 1337))))
(length (fs:find 'b 1337)))
0)
(test-check "fs:update!"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(fs:update! (fs:add! '((a . 42) (b . 1337))) '((a . 42)))
(length (fs:find 'b 1337)))
0)
(test-check "fs:query"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(fs:add! '((a . 42) (b . 1337)))
(fs:add! '((a . 0) (c . 1337)))
(length (fs:query uid? fs:where ((uid? 'a 42)))))
1)
(test-check "fs:query2"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(fs:add! '((a . 42) (b . 1337)))
(fs:add! '((a . 0) (c . 1337)))
(length (fs:query uid? fs:where ((uid? 'a 42) (uid? 'b 1337)))))
1)
(test-check "fs:query3"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(fs:add! '((a . 42) (b . 1337)))
(fs:add! '((a . 0) (c . 1337)))
(length (fs:query uid? fs:where ((uid? 'a 42) (uid? 'b 42)))))
0)
(test-check "fs:query4"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(let* ((concept/fruit (fs:add! (list '(name . "fruit"))))
(concept/strawberry (fs:add! (list '(name . "strawberry"))))
(concept/fig (fs:add! (list '(name . "fig"))))
......@@ -79,7 +79,7 @@
(test-check "microkanren fs:queryo"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
;; fixture
(let* ((concept/fruit (fs:add! (list '(name . "fruit"))))
(concept/strawberry (fs:add! (list '(name . "strawberry"))))
......
......@@ -14,18 +14,18 @@
(test-begin)
(test-check "open database"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
42)
42)
(test-check "create vertex"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(let ((vertex (create-vertex '((a . 42)))))
(vertex-ref (get (vertex-uid vertex)) 'a)))
42)
(test-check "create edge"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(let* ((start (create-vertex '()))
(end (create-vertex '()))
(edge (create-edge start end '((a . 42)))))
......@@ -33,25 +33,25 @@
42)
(test-check "get unknown element"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(get "FOOBAR"))
#false)
(test-check "get-or-create-vertex new true"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(receive (new vertex) (get-or-create-vertex 'a 42)
new))
#true)
(test-check "get-or-create-vertex new false"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(receive (new vertex) (get-or-create-vertex 'a 42)
(receive (new vertex) (get-or-create-vertex 'a 42)
new)))
#false)
(test-check "save vertex"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(let* ((a (create-vertex '((a . 42))))
(a (vertex-set a 'b 1337)))
(save a)
......@@ -59,7 +59,7 @@
1337)
(test-check "save edge"
(with-env (env-open* "/tmp/wt" (list *feature-space*) "create")
(with-env (env-open* "wt" (list *feature-space*) "create")
(let* ((start (create-vertex '()))
(end (create-vertex '()))
(edge (create-edge start end '((a . 42)))))
......
......@@ -69,7 +69,7 @@
(define-syntax test-check
(syntax-rules ()
((_ title tested-expression expected-result)
(with-directory "/tmp/wt"
(with-directory "wt"
(format #t "** Checking ~a\n" title)
(let* ((expected expected-result)
(produced tested-expression))
......
......@@ -9,12 +9,12 @@
(test-begin)
(test-check "index"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(not (null? (index "http://example.net" "foo bar baz"))))
#t)
(test-check "query-terms 1"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "http://example.net" "database")
(index "http://example.net" "spam")
(index "http://example.net" "egg")
......@@ -24,7 +24,7 @@
'(2 1))
(test-check "query-terms 2"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "http://example.net" "database")
(index "http://example.net" "spam")
(index "http://example.net" "egg")
......@@ -35,7 +35,7 @@
'(4 5 2 1))
(test-check "query-terms 3"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "http://example.net" "database")
(index "http://example.net" "spam")
(index "http://example.net" "egg")
......@@ -47,7 +47,7 @@
'(4 5 2 1))
(test-check "search/vm and/or"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "1" "database & postgresql")
(index "2" "spam & pgsql")
(index "3" "spam & egg")
......@@ -58,7 +58,7 @@
'("5" "1"))
(test-check "search/vm or avoid duplicates"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "1" "database")
(index "2" "wiredtiger & database")
(index "3" "wiredtiger")
......@@ -68,13 +68,13 @@
'("2" "1" "3"))
(test-check "search/vm avoid duplicates"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "1" "wiredtiger & wiredtiger")
(search/vm (query/term "wiredtiger")))
'("1"))
(test-check "search/vm and/not"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "1" "database & postgresql")
(index "2" "spam & pgsql")
(index "3" "spam & egg")
......@@ -85,7 +85,7 @@
'("5" "1"))
(test-check "search/vm and/not/and"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "1" "database & egg")
(index "2" "database & spam & egg")
(index "3" "database & spam & egg")
......@@ -96,7 +96,7 @@
'("5" "4" "1"))
(test-check "search/vm and/not"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "1" "database & postgresql")
(index "2" "spam & pgsql")
(index "3" "spam & egg")
......@@ -108,7 +108,7 @@
'("1"))
(test-check "search*"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "http://database.postgresql.pgsql.net" "database & postgresql & pgsql")
(index "http://database.postgresql.net" "database & postgresql")
(index "http://spam.egg.net" "spam & egg")
......@@ -125,7 +125,7 @@
("http://database.pgsql.spam.net" . 2)))
(test-check "search/vm unknown keyword"
(with-env (env-open* "/tmp/wt" *ix* "create")
(with-env (env-open* "wt" *ix* "create")
(index "1" "database & postgresql")
(index "2" "spam & pgsql")
(index "3" "spam & egg")
......
......@@ -9,11 +9,11 @@
(test-begin)
(test-check "create and close database"
(with-cnx (connection-open "/tmp/wt" "create") #true)
(with-cnx (connection-open "wt" "create") #true)
#true)
(test-check "table with index, insert and index value"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
;; create a table
(session-create session "table:nodes" "key_format=Q,value_format=SS,columns=(a,b,c)")
......@@ -32,7 +32,7 @@
(list (list "a" "b") (list 42)))
(test-check "cursor search on empty table"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
;; create a table
(session-create session "table:nodes" "key_format=Q,value_format=SS,columns=(a,b,c)")
......@@ -46,7 +46,7 @@
#true)
(test-check "cursor search"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
;; create a table
(session-create session "table:nodes" "key_format=Q,value_format=SS,columns=(a,b,c)")
......@@ -63,7 +63,7 @@
#true)
(test-check "cursor search near on empty table"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
(session-create session "table:nodes" "key_format=Q,value_format=S,columns=(a,b)")
(let ((cursor (cursor-open session "table:nodes")))
......@@ -75,7 +75,7 @@
#true)
(test-check "cursor search near below"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
(session-create session "table:nodes" "key_format=Q,value_format=S,columns=(a,b)")
(let ((cursor (cursor-open session "table:nodes")))
......@@ -90,7 +90,7 @@
-1)
(test-check "cursor search near above"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
(session-create session "table:nodes" "key_format=Q,value_format=S,columns=(a,b)")
(let ((cursor (cursor-open session "table:nodes")))
......@@ -111,7 +111,7 @@
#true)
(test-check "cursor search near exact match"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
(session-create session "table:nodes" "key_format=Q,value_format=S,columns=(a,b)")
(let ((cursor (cursor-open session "table:nodes")))
......@@ -132,7 +132,7 @@
0)
(test-check "record table, insert and retrieve key"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
(session-create session "table:terms" "key_format=r,value_format=S")
(let ((cursor (cursor-open session "table:terms" "append")))
......@@ -142,7 +142,7 @@
1)
(test-check "raw item, insert and retrieve value"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(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")))
......@@ -155,14 +155,14 @@
'(#vu8(1 2 3 4)))
(test-check "wiredtiger-struct-size"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
(with-cnx cnx
(wiredtiger-struct-size session "qQS" 1 42 "héllo")))
'9)
(test-check "wiredtiger-struct-pack/unpack"
(let* ((cnx (connection-open "/tmp/wt" "create"))
(let* ((cnx (connection-open "wt" "create"))
(session (session-open cnx)))
(with-cnx cnx
(wiredtiger-struct-unpack session
......@@ -171,7 +171,7 @@
'(1 42 "héllo"))
;; (test-check "create table with scheme collator"
;; (receive (cnx ctx) (wiredtiger-open* "/tmp/wt" '(table
;; (receive (cnx ctx) (wiredtiger-open* "wt" '(table
;; ((key . record))
;; ((scheme . string))
;; ((reversed (scheme) (key)))))
......@@ -206,7 +206,7 @@
;; out)))))
;; '(("B") ("b") ("A") ("a")))
;; (test-check "create table with collator"
;; (let* ((cnx (connection-open "/tmp/wt" "create"))
;; (let* ((cnx (connection-open "wt" "create"))
;; (session (session-open cnx)))
;; (connection-add-collator cnx "ci" "Sr" (lambda (key other)
;; (if (string=? (car key) (car other))
......