ldiff.lsp 4.09 KB
Newer Older
1 2
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
3 4
;;;; Created:  Sat Apr 19 22:46:56 2003
;;;; Contains: Tests of LDIFF
5

6

7

8

9

10 11
(deftest ldiff.1
  (let* ((x (copy-tree '(a b c d e f)))
sds's avatar
sds committed
12
         (xcopy (make-scaffold-copy x)))
13 14
    (let ((result (ldiff x (cdddr x))))
      (and (check-scaffold-copy x xcopy)
sds's avatar
sds committed
15
           result)))
16 17
  (a b c))

18
(deftest ldiff.2
19
  (let* ((x (copy-tree '(a b c d e f)))
sds's avatar
sds committed
20
         (xcopy (make-scaffold-copy x)))
21 22 23 24
    (let ((result (ldiff x 'a)))
      (and
       (check-scaffold-copy x xcopy)
       (zerop
sds's avatar
sds committed
25 26 27
        (loop
         for a on x and b on result count
         (eqt a b)))
28
       result)))
29 30 31
  (a b c d e f))

;; Works when the end of the dotted list is a symbol
32 33
(deftest ldiff.3
  (let* ((x (copy-tree '(a b c d e . f)))
sds's avatar
sds committed
34
         (xcopy (make-scaffold-copy x)))
35 36 37 38
    (let ((result (ldiff x 'a)))
      (and
       (check-scaffold-copy x xcopy)
       result)))
39 40 41
  (a b c d e . f))

;; Works when the end of the dotted list is a fixnum
42
(deftest ldiff.4
43
  (let* ((n 18)
sds's avatar
sds committed
44 45
         (x (list* 'a 'b 'c 18))
         (xcopy (make-scaffold-copy x)))
46
    (let ((result (ldiff x n)))
47 48 49 50 51 52 53
      (and
       (check-scaffold-copy x xcopy)
       result)))
  (a b c))

;; Works when the end of the dotted list is a larger
;; integer (that is eql, but probably not eq).
54
(deftest ldiff.5
55
  (let* ((n 18000000000000)
sds's avatar
sds committed
56 57
         (x (list* 'a 'b 'c (1- 18000000000001)))
         (xcopy (make-scaffold-copy x)))
58
    (let ((result (ldiff x n)))
59 60 61 62 63 64
      (and
       (check-scaffold-copy x xcopy)
       result)))
  (a b c))

;; Test works when the end of a dotted list is a string
65
(deftest ldiff.6
66
  (let* ((n (copy-seq "abcde"))
sds's avatar
sds committed
67 68
         (x (list* 'a 'b 'c n))
         (xcopy (make-scaffold-copy x)))
69
    (let ((result (ldiff x n)))
70
      (if (equal result (list 'a 'b 'c))
sds's avatar
sds committed
71 72
          (check-scaffold-copy x xcopy)
        result)))
73 74 75 76
  t)

;; Check that having the cdr of a dotted list be string-equal, but
;; not eql, does not result in success
77
(deftest ldiff.7
78
  (let* ((n (copy-seq "abcde"))
sds's avatar
sds committed
79 80
         (x (list* 'a 'b 'c n))
         (xcopy (make-scaffold-copy x)))
81
    (let ((result (ldiff x (copy-seq n))))
82
      (if (equal result x)
sds's avatar
sds committed
83 84
          (check-scaffold-copy x xcopy)
        result)))
85 86 87 88 89
  t)

;; Check that on failure, the list returned by ldiff is
;; a copy of the list, not the list itself.

90 91 92 93
(deftest ldiff.8
  (let ((x (list 'a 'b 'c 'd)))
    (let ((result (ldiff x '(e))))
      (and (equal x result)
sds's avatar
sds committed
94 95 96 97
           (loop
            for c1 on x
            for c2 on result
            count (eqt c1 c2)))))
98
  0)
99

100
(deftest ldiff.order.1
101 102 103
  (let ((i 0) x y)
    (values
     (ldiff (progn (setf x (incf i))
sds's avatar
sds committed
104 105 106
                   (list* 'a 'b 'c 'd))
            (progn (setf y (incf i))
                   'd))
107
     i x y))
pfdietz's avatar
pfdietz committed
108 109 110 111
  (a b c) 2 1 2)

(def-fold-test ldiff.fold.1 (ldiff '(a b c) 'x))
(def-fold-test ldiff.fold.2 (let ((x '(a b c))) (ldiff x (cddr x))))
112 113 114

;; Error checking

115
(deftest ldiff.error.1
116
  (signals-type-error x 10 (ldiff x 'a))
117
  t)
118 119 120

;; Single atoms are not dotted lists, so the next
;; 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 139
  (signals-error (ldiff) program-error)
  t)
140 141

(deftest ldiff.error.7
142 143
  (signals-error (ldiff nil) program-error)
  t)
144 145

(deftest ldiff.error.8
146 147
  (signals-error (ldiff nil nil nil) program-error)
  t)
148

149 150 151 152 153 154 155 156 157 158 159
;; Note!  The spec is ambiguous on whether this next test
;; is correct.  The spec says that ldiff should be prepared
;; to signal an error if the list argument is not a proper
;; list or dotted list.  If listp is false, the list argument
;; is neither (atoms are not dotted lists).
;;
;; However, the sample implementation *does* work even if
;; the list argument is an atom.
;;
#|
(defun ldiff-12-body ()
160 161 162
  (loop
   for x in *universe*
   count (and (not (listp x))
sds's avatar
sds committed
163 164
              (not (eqt 'type-error
                        (catch-type-error (ldiff x x)))))))
165 166

(deftest ldiff-12
167
  (ldiff-12-body)
168 169
  0)
|#