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

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

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

File size: 3.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 19 22:46:56 2003
4;;;; Contains: Tests of LDIFF
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest ldiff.1
11  (let* ((x (copy-tree '(a b c d e f)))
12         (xcopy (make-scaffold-copy x)))
13    (let ((result (ldiff x (cdddr x))))
14      (and (check-scaffold-copy x xcopy)
15           result)))
16  (a b c))
17
18(deftest ldiff.2
19  (let* ((x (copy-tree '(a b c d e f)))
20         (xcopy (make-scaffold-copy x)))
21    (let ((result (ldiff x 'a)))
22      (and
23       (check-scaffold-copy x xcopy)
24       (zerop
25        (loop
26         for a on x and b on result count
27         (eqt a b)))
28       result)))
29  (a b c d e f))
30
31;; Works when the end of the dotted list is a symbol
32(deftest ldiff.3
33  (let* ((x (copy-tree '(a b c d e . f)))
34         (xcopy (make-scaffold-copy x)))
35    (let ((result (ldiff x 'a)))
36      (and
37       (check-scaffold-copy x xcopy)
38       result)))
39  (a b c d e . f))
40
41;; Works when the end of the dotted list is a fixnum
42(deftest ldiff.4
43  (let* ((n 18)
44         (x (list* 'a 'b 'c 18))
45         (xcopy (make-scaffold-copy x)))
46    (let ((result (ldiff x n)))
47      (and
48       (check-scaffold-copy x xcopy)
49       result)))
50  (a b c))
51
52;; Works when the end of the dotted list is a larger
53;; integer (that is eql, but probably not eq).
54(deftest ldiff.5
55  (let* ((n 18000000000000)
56         (x (list* 'a 'b 'c (1- 18000000000001)))
57         (xcopy (make-scaffold-copy x)))
58    (let ((result (ldiff x n)))
59      (and
60       (check-scaffold-copy x xcopy)
61       result)))
62  (a b c))
63
64;; Test works when the end of a dotted list is a string
65(deftest ldiff.6
66  (let* ((n (copy-seq "abcde"))
67         (x (list* 'a 'b 'c n))
68         (xcopy (make-scaffold-copy x)))
69    (let ((result (ldiff x n)))
70      (if (equal result (list 'a 'b 'c))
71          (check-scaffold-copy x xcopy)
72        result)))
73  t)
74
75;; Check that having the cdr of a dotted list be string-equal, but
76;; not eql, does not result in success
77(deftest ldiff.7
78  (let* ((n (copy-seq "abcde"))
79         (x (list* 'a 'b 'c n))
80         (xcopy (make-scaffold-copy x)))
81    (let ((result (ldiff x (copy-seq n))))
82      (if (equal result x)
83          (check-scaffold-copy x xcopy)
84        result)))
85  t)
86
87;; Check that on failure, the list returned by ldiff is
88;; a copy of the list, not the list itself.
89
90(deftest ldiff.8
91  (let ((x (list 'a 'b 'c 'd)))
92    (let ((result (ldiff x '(e))))
93      (and (equal x result)
94           (loop
95            for c1 on x
96            for c2 on result
97            count (eqt c1 c2)))))
98  0)
99
100(deftest ldiff.order.1
101  (let ((i 0) x y)
102    (values
103     (ldiff (progn (setf x (incf i))
104                   (list* 'a 'b 'c 'd))
105            (progn (setf y (incf i))
106                   'd))
107     i x y))
108  (a b c) 2 1 2)
109
110(def-fold-test ldiff.fold.1 (ldiff '(a b c) 'x))
111(def-fold-test ldiff.fold.2 (let ((x '(a b c))) (ldiff x (cddr x))))
112
113;; Error checking
114
115(deftest ldiff.error.1
116  (signals-type-error x 10 (ldiff x 'a))
117  t)
118
119;; Single atoms are not dotted lists, so the next
120;; case should be a type-error
121(deftest ldiff.error.2
122  (signals-type-error x 'a (ldiff x 'a))
123  t)
124
125(deftest ldiff.error.3
126  (signals-type-error x (make-array '(10) :initial-element 'a) (ldiff x '(a)))
127  t)
128
129(deftest ldiff.error.4
130  (signals-type-error x 1.23 (ldiff x t))
131  t)
132
133(deftest ldiff.error.5
134  (signals-type-error x #\w (ldiff x 'a))
135  t)
136
137(deftest ldiff.error.6
138  (signals-error (ldiff) program-error)
139  t)
140
141(deftest ldiff.error.7
142  (signals-error (ldiff nil) program-error)
143  t)
144
145(deftest ldiff.error.8
146  (signals-error (ldiff nil nil nil) program-error)
147  t)
148
149;; Note!  The spec is ambiguous on whether this next test
150;; is correct.  The spec says that ldiff should be prepared
151;; to signal an error if the list argument is not a proper
152;; list or dotted list.  If listp is false, the list argument
153;; is neither (atoms are not dotted lists).
154;;
155;; However, the sample implementation *does* work even if
156;; the list argument is an atom.
157;;
158#|
159(defun ldiff-12-body ()
160  (loop
161   for x in *universe*
162   count (and (not (listp x))
163              (not (eqt 'type-error
164                        (catch-type-error (ldiff x x)))))))
165
166(deftest ldiff-12
167  (ldiff-12-body)
168  0)
169|#
Note: See TracBrowser for help on using the repository browser.