Claude (zset-rollback)
2234ea6318
Co-Authored-By: Claude Sonnet 5.5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01VdfEGXA7aJ6ftMsCc9PJze
76 lines
3.7 KiB
Common Lisp
76 lines
3.7 KiB
Common Lisp
;;; A CFFI smoke test: load libzset_ffi, add weights, query, hit the overflow code, free.
|
|
;;; Run: sbcl --non-interactive --load ~/quicklisp/setup.lisp \
|
|
;;; --eval '(defvar cl-user::*zset-lib* "target/release/libzset_ffi.dylib")' \
|
|
;;; --load crates/zset-ffi/tests/smoke.lisp
|
|
;;; Not a CI gate: sbcl and cffi are not in the dev shell. See context/code/zset-ffi.md.
|
|
(ql:quickload :cffi :silent t)
|
|
(defpackage :zset-smoke (:use :cl :cffi))
|
|
(in-package :zset-smoke)
|
|
|
|
(load-foreign-library cl-user::*zset-lib*)
|
|
|
|
(defcfun "zs_abi_version" :uint32)
|
|
(defcfun "zs_last_error" :string)
|
|
(defcfun "zs_zset_new" :int32 (out :pointer))
|
|
(defcfun "zs_zset_free" :void (z :pointer))
|
|
(defcfun "zs_zset_insert" :int32 (z :pointer) (key :pointer) (len :size) (weight :int64))
|
|
(defcfun "zs_zset_weight" :int32 (z :pointer) (key :pointer) (len :size) (out :pointer))
|
|
(defcfun "zs_zset_len" :int32 (z :pointer) (out :pointer))
|
|
|
|
(defconstant +overflow+ 2)
|
|
|
|
(defun check (what got want)
|
|
(unless (equal got want) (error "~a: got ~s, wanted ~s" what got want))
|
|
(format t "ok ~a~%" what))
|
|
|
|
(defun key-call (fn z key &rest more)
|
|
"Calls FN with Z, a foreign copy of the string KEY's UTF-8 bytes, its length, MORE."
|
|
(with-foreign-string ((ptr len) key :null-terminated-p nil)
|
|
(apply fn z ptr len more)))
|
|
|
|
(with-foreign-object (out :pointer)
|
|
(check "new" (zs-zset-new out) 0)
|
|
(let ((z (mem-ref out :pointer)))
|
|
(check "insert" (key-call #'zs-zset-insert z "k" 40) 0)
|
|
(check "insert again" (key-call #'zs-zset-insert z "k" 2) 0)
|
|
(with-foreign-object (w :int64)
|
|
(check "weight" (progn (key-call #'zs-zset-weight z "k" w) (mem-ref w :int64)) 42)
|
|
(check "overflow code" (key-call #'zs-zset-insert z "k" (1- (expt 2 63))) +overflow+)
|
|
(check "error text" (and (search "overflow" (zs-last-error)) t) t)
|
|
(check "unchanged" (progn (key-call #'zs-zset-weight z "k" w) (mem-ref w :int64)) 42))
|
|
(zs-zset-free z)))
|
|
|
|
;;; A callback: the body is wrapped in handler-case and returns the failure value, because a
|
|
;;; non-local exit through the library would leave the circuit dead (ZS_ERR_POISONED).
|
|
(defcfun "zs_circuit_new" :int32 (out :pointer))
|
|
(defcfun "zs_circuit_free" :void (c :pointer))
|
|
(defcfun "zs_circuit_input" :int32 (c :pointer) (out :pointer))
|
|
(defcfun "zs_circuit_filter" :int32 (c :pointer) (stream :uint32) (keep :pointer) (ctx :pointer) (out :pointer))
|
|
(defcfun "zs_circuit_push" :int32 (c :pointer) (input :uint32) (z :pointer))
|
|
(defcfun "zs_circuit_step" :int32 (c :pointer))
|
|
(defcfun "zs_circuit_begin" :int32 (c :pointer))
|
|
(defcfun "zs_circuit_rollback" :int32 (c :pointer))
|
|
|
|
(defcallback keep-or-fail :int32 ((ctx :pointer) (key :pointer) (len :size))
|
|
(declare (ignore ctx key len))
|
|
(handler-case (error "a Lisp error inside a callback")
|
|
(error () -1)))
|
|
|
|
(with-foreign-objects ((cout :pointer) (id :uint32) (zout :pointer))
|
|
(check "circuit" (zs-circuit-new cout) 0)
|
|
(let ((c (mem-ref cout :pointer)))
|
|
(check "input" (zs-circuit-input c id) 0)
|
|
(check "filter" (zs-circuit-filter c (mem-ref id :uint32) (callback keep-or-fail) (null-pointer) id) 0)
|
|
(check "zset" (zs-zset-new zout) 0)
|
|
(key-call #'zs-zset-insert (mem-ref zout :pointer) "k" 1)
|
|
(check "begin a transaction" (zs-circuit-begin c) 0)
|
|
(check "push" (zs-circuit-push c 0 (mem-ref zout :pointer)) 0)
|
|
(check "step reports the callback's failure" (zs-circuit-step c) 8)
|
|
(check "the circuit is dead afterwards" (zs-circuit-step c) 7)
|
|
(check "rollback revives it" (zs-circuit-rollback c) 0)
|
|
(check "a transaction opens again" (zs-circuit-begin c) 0)
|
|
(check "and a second begin is refused" (zs-circuit-begin c) 10)
|
|
(zs-zset-free (mem-ref zout :pointer))
|
|
(zs-circuit-free c)))
|
|
(format t "zset smoke: all ok~%")
|