1 | ;-*- Mode: Lisp -*- |
---|
2 | ;;;; Author: Paul Dietz |
---|
3 | ;;;; Created: Sun Apr 20 07:30:55 2003 |
---|
4 | ;;;; Contains: Tests of PAIRLIS |
---|
5 | |
---|
6 | (in-package :cl-test) |
---|
7 | |
---|
8 | (compile-and-load "cons-aux.lsp") |
---|
9 | |
---|
10 | ;; Pairlis has two legal behaviors: the pairs |
---|
11 | ;; can be prepended in the same order, or in the |
---|
12 | ;; reverse order, that they appear in the first |
---|
13 | ;; two arguments |
---|
14 | |
---|
15 | (defun my-pairlis (x y &optional alist) |
---|
16 | (if (null x) |
---|
17 | alist |
---|
18 | (acons (car x) (car y) |
---|
19 | (my-pairlis (cdr x) (cdr y) alist)))) |
---|
20 | |
---|
21 | (deftest pairlis.1 |
---|
22 | (pairlis nil nil nil) |
---|
23 | nil) |
---|
24 | |
---|
25 | (deftest pairlis.2 |
---|
26 | (pairlis '(a) '(b) nil) |
---|
27 | ((a . b))) |
---|
28 | |
---|
29 | (deftest pairlis.3 |
---|
30 | (let* ((x (copy-list '(a b c d e))) |
---|
31 | (xcopy (make-scaffold-copy x)) |
---|
32 | (y (copy-list '(1 2 3 4 5))) |
---|
33 | (ycopy (make-scaffold-copy y)) |
---|
34 | (result (pairlis x y)) |
---|
35 | (expected (my-pairlis x y))) |
---|
36 | (and |
---|
37 | (check-scaffold-copy x xcopy) |
---|
38 | (check-scaffold-copy y ycopy) |
---|
39 | (or |
---|
40 | (equal result expected) |
---|
41 | (equal result (reverse expected))) |
---|
42 | t)) |
---|
43 | t) |
---|
44 | |
---|
45 | (deftest pairlis.4 |
---|
46 | (let* ((x (copy-list '(a b c d e))) |
---|
47 | (xcopy (make-scaffold-copy x)) |
---|
48 | (y (copy-list '(1 2 3 4 5))) |
---|
49 | (ycopy (make-scaffold-copy y)) |
---|
50 | (z '((x . 10) (y . 20))) |
---|
51 | (zcopy (make-scaffold-copy z)) |
---|
52 | (result (pairlis x y z)) |
---|
53 | (expected (my-pairlis x y z))) |
---|
54 | (and |
---|
55 | (check-scaffold-copy x xcopy) |
---|
56 | (check-scaffold-copy y ycopy) |
---|
57 | (check-scaffold-copy z zcopy) |
---|
58 | (eqt (cdr (cddr (cddr result))) z) |
---|
59 | (or |
---|
60 | (equal result expected) |
---|
61 | (equal result (append (reverse (subseq expected 0 5)) |
---|
62 | (subseq expected 5)))) |
---|
63 | t)) |
---|
64 | t) |
---|
65 | |
---|
66 | (def-fold-test pairlis.fold.1 (pairlis '(a b) '(c d))) |
---|
67 | |
---|
68 | ;;; Error tests |
---|
69 | |
---|
70 | (deftest pairlis.error.1 |
---|
71 | (signals-error (pairlis) program-error) |
---|
72 | t) |
---|
73 | |
---|
74 | (deftest pairlis.error.2 |
---|
75 | (signals-error (pairlis nil) program-error) |
---|
76 | t) |
---|
77 | |
---|
78 | (deftest pairlis.error.3 |
---|
79 | (signals-error (pairlis nil nil nil nil) program-error) |
---|
80 | t) |
---|
81 | |
---|
82 | (deftest pairlis.error.4 |
---|
83 | (signals-error (pairlis 'a '(1)) type-error) |
---|
84 | t) |
---|
85 | |
---|
86 | (deftest pairlis.error.5 |
---|
87 | (signals-error (pairlis '(a) 'b) type-error) |
---|
88 | t) |
---|
89 | |
---|
90 | (deftest pairlis.error.6 |
---|
91 | (signals-error (pairlis '(a . b) '(c . d)) type-error) |
---|
92 | t) |
---|
93 | |
---|
94 | (deftest pairlis.error.7 |
---|
95 | (check-type-error #'(lambda (x) (pairlis x '(a b))) #'listp) |
---|
96 | nil) |
---|
97 | |
---|
98 | (deftest pairlis.error.8 |
---|
99 | (check-type-error #'(lambda (x) (pairlis '(a b) x)) #'listp) |
---|
100 | nil) |
---|