source: trunk/source/tests/ansi-tests/pairlis.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.3 KB
Line 
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)
Note: See TracBrowser for help on using the repository browser.