test/test-scheme-cxr.sgl

1;;; Tests for (scheme cxr) — R7RS-compliant 3- and 4-level car/cdr accessors.

3(import (sigil test)

4 (scheme cxr))

6(test-group "scheme-cxr 3-level"

7 (test "caaar" (assert-equal 1 (caaar '(((1)) 2))))

8 (test "caadr" (assert-equal 2 (caadr '(1 (2 3) 4))))

9 (test "cadar" (assert-equal 2 (cadar '((1 2 3) other))))

10 (test "caddr" (assert-equal 3 (caddr '(1 2 3 4))))

11 (test "cdaar" (assert-equal '(2 3) (cdaar '(((1 2 3)) other))))

12 (test "cdadr" (assert-equal '(3 4) (cdadr '(1 (2 3 4) other))))

13 (test "cddar" (assert-equal '(3) (cddar '((1 2 3) other))))

14 (test "cdddr" (assert-equal '(4) (cdddr '(1 2 3 4)))))

16(test-group "scheme-cxr 4-level"

17 (test "caaaar" (assert-equal 'deep (caaaar '((((deep)))))))

18 (test "caaadr" (assert-equal 'deep (caaadr '(x ((deep)) y))))

19 (test "caadar" (assert-equal 'deep (caadar '((x (deep) y) other))))

20 (test "caaddr" (assert-equal 'deep (caaddr '(x y (deep) z))))

21 (test "cadaar" (assert-equal 'b (cadaar '(((a b c)) other))))

22 (test "cadadr" (assert-equal 'b (cadadr '(x (a b c) other))))

23 (test "caddar" (assert-equal 'c (caddar '((a b c) other))))

24 (test "cadddr" (assert-equal 4 (cadddr '(1 2 3 4 5))))

25 (test "cdaaar" (assert-equal '(2) (cdaaar '((((1 2))) other))))

26 (test "cdaadr" (assert-equal '(2) (cdaadr '(x ((1 2)) y))))

27 (test "cdadar" (assert-equal '(2) (cdadar '((x (1 2) y) other))))

28 (test "cdaddr" (assert-equal '(b c) (cdaddr '(x y (a b c) z))))

29 (test "cddaar" (assert-equal '(3) (cddaar '(((1 2 3)) other))))

30 (test "cddadr" (assert-equal '(3) (cddadr '(x (1 2 3) other))))

31 (test "cdddar" (assert-equal '(4) (cdddar '((1 2 3 4) other))))

32 (test "cddddr" (assert-equal '(5 6) (cddddr '(1 2 3 4 5 6)))))