Commits

llibra  committed 7c82015

Refactored the tests of KC.CUR:GET-KEY and KC.CUR.LOW:GET-KEY.

  • Participants
  • Parent commits 38aed21

Comments (0)

Files changed (1)

     (kc.db:set db "set" "but not used")
     (5am:is (zerop (kc.cur:with-cursor (cur db) 0)))))
 
-(labels ((value-and-length (fn)
-           (with-new-db (db)
-             (kc.db:set db "x" "1")
-             (kc.cur:with-cursor (cur db)
-               (multiple-value-bind (ptr len) (funcall fn cur t)
-                 (kc.util:with-kcmalloced-pointer (ptr ptr)
-                   (5am:is (equal "x" (cffi:foreign-string-to-lisp ptr))))
-                 (5am:is (= 1 len))))))
-         (step (fn)
-           (with-new-db (db)
-             (kc.db:set db "x" "1")
-             (kc.cur:with-cursor (cur db)
-               ;; Expect no record.
-               (5am:signals kc.cur:error
-                 (progn (kc.ffi:kcfree (funcall fn cur t))
-                        (funcall fn cur t)))
-               (kc.cur:jump cur)
-               (5am:finishes
-                 (progn (kc.ffi:kcfree (funcall fn cur nil))
-                        (kc.ffi:kcfree (funcall fn cur t)))))))
-         (get-x/low (fn)
-           (value-and-length fn)
-           (step fn)))
-  (5am:test (get-key/low :compile-at :definition-time)
-    (get-x/low #'kc.cur.low:get-key)))
+(flet ((body (key value fn value-pred len-pred)
+         (with-new-db (db)
+           (kc.db:set db key value)
+           (kc.cur:with-cursor (cur db)
+             (multiple-value-bind (ptr len) (funcall fn cur t)
+               (kc.util:with-kcmalloced-pointer (ptr ptr)
+                 (let ((s (cffi:foreign-string-to-lisp ptr)))
+                   (5am:is (funcall value-pred s))))
+               (5am:is (funcall len-pred len)))))))
+  (5am:test (get-key/low/value :compile-at :definition-time)
+    (body "x" "1"
+          #'kc.cur.low:get-key
+          (lambda (v) (equal "x" v))
+          (lambda (l) (= 1 l)))))
 
-(5am:test get-key
-  (with-new-db (db)
-    (kc.db:set db "x" "1")
-    (kc.cur:with-cursor (cur db)
-      (5am:is (equal "x" (kc.cur:get-key cur t)))
-      (5am:signals kc.cur:error (kc.cur:get-key cur t))
-      (kc.cur:jump cur)
-      (5am:finishes (progn (kc.cur:get-key cur nil)
-                           (kc.cur:get-key cur t))))))
+(flet ((body (key value fn pred)
+         (with-new-db (db)
+           (kc.db:set db key value)
+           (kc.cur:with-cursor (cur db)
+             (5am:is (funcall pred (funcall fn cur)))))))
+  (5am:test (get-key/value :compile-at :definition-time)
+    (body "x" "1"
+          (lambda (c) (kc.cur:get-key c nil))
+          (lambda (v) (equal "x" v)))))
+
+(flet ((body (fn)
+         (with-new-db (db)
+           (kc.db:set db "x" "1")
+           (kc.cur:with-cursor (cur db)
+             ;; Expect no record.
+             (5am:signals kc.cur:error
+               (progn (funcall fn cur t) (funcall fn cur t)))
+             (kc.cur:jump cur)
+             (5am:finishes
+               (progn (funcall fn cur nil) (funcall fn cur t)))))))
+  (5am:test (get-key/low/step :compile-at :definition-time)
+    (body (lambda (cur step)
+            (kc.ffi:kcfree (kc.cur.low:get-key cur step)))))
+  (5am:test (get-key/step :compile-at :definition-time)
+    (body #'kc.cur:get-key)))