AtlatestRepositorysigil-hooks

sigil-hooks / tree / testtest-hooks.sgl

1(import (sigil test)
2 (sigil hooks))
3
4;; ============================================================
5;; Creation
6;; ============================================================
7
8(test-group "hook creation"
9 (test "make-hook returns a hook"
10 (assert-true (hook? (make-hook))))
12 (test "hook? false on non-hook"
13 (assert-false (hook? 42))
14 (assert-false (hook? '()))
15 (assert-false (hook? "hello")))
17 (test "new hook is empty"
18 (assert-true (hook-empty? (make-hook)))))
20;; ============================================================
21;; Adding and removing
22;; ============================================================
24(test-group "hook management"
25 (test "add-hook! makes hook non-empty"
26 (let ((h (make-hook)))
27 (add-hook! h (lambda () #t))
28 (assert-false (hook-empty? h))))
30 (test "remove-hook! by identity"
31 (let ((h (make-hook))
32 (fn (lambda () #t)))
33 (add-hook! h fn)
34 (remove-hook! h fn)
35 (assert-true (hook-empty? h))))
37 (test "clear-hook! empties hook"
38 (let ((h (make-hook)))
39 (add-hook! h (lambda () 1))
40 (add-hook! h (lambda () 2))
41 (clear-hook! h)
42 (assert-true (hook-empty? h)))))
44;; ============================================================
45;; Running hooks
46;; ============================================================
48(test-group "running hooks"
49 (test "run-hook calls handlers in order"
50 (let ((h (make-hook))
51 (results '()))
52 (add-hook! h (lambda () (set! results (append results '(1)))))
53 (add-hook! h (lambda () (set! results (append results '(2)))))
54 (add-hook! h (lambda () (set! results (append results '(3)))))
55 (run-hook h)
56 (assert-equal '(1 2 3) results)))
58 (test "run-hook-with-args passes arguments"
59 (let ((h (make-hook))
60 (results '()))
61 (add-hook! h (lambda (x y) (set! results (list x y))))
62 (run-hook-with-args h 10 20)
63 (assert-equal '(10 20) results))))
65;; ============================================================
66;; Edge cases
67;; ============================================================
69(test-group "edge cases"
70 (test "run-hook on empty hook is fine"
71 (run-hook (make-hook))
72 (assert-true #t))
74 (test "remove handler not present is fine"
75 (let ((h (make-hook)))
76 (remove-hook! h (lambda () #t))
77 (assert-true (hook-empty? h)))))
79(run-tests)