tailp.lsp 2.13 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 22:47:26 2003
;;;; Contains: Tests of TAILP

(in-package :cl-test)

8 9
(compile-and-load "cons-aux.lsp")

10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
(deftest tailp.1
  (let ((x (copy-tree '(a b c d e . f))))
    (and
     (tailp x x)
     (tailp (cdr x) x)
     (tailp (cddr x) x)
     (tailp (cdddr x) x)
     (tailp (cddddr x) x)
     t))
  t)

;; The next four tests test that tailp handles dotted lists.  See
;; TAILP-NIL:T in the X3J13 documentation.

(deftest tailp.2
  (notnot-mv (tailp 'e (copy-tree '(a b c d . e))))
  t)

(deftest tailp.3
  (tailp 'z (copy-tree '(a b c d . e)))
  nil)

(deftest tailp.4
  (notnot-mv (tailp 10203040506070
sds's avatar
sds committed
34
                    (list* 'a 'b (1- 10203040506071))))
35 36 37 38 39 40 41
  t)

(deftest tailp.5
  (let ((x "abcde")) (tailp x (list* 'a 'b (copy-seq x))))
  nil)

(deftest tailp.error.5
42 43
  (signals-error (tailp) program-error)
  t)
44 45

(deftest tailp.error.6
46 47
  (signals-error (tailp nil) program-error)
  t)
48 49

(deftest tailp.error.7
50 51
  (signals-error (tailp nil nil nil) program-error)
  t)
52 53 54 55 56

;; Test that tailp does not modify its arguments

(deftest tailp.6
    (let* ((x (copy-list '(a b c d e)))
sds's avatar
sds committed
57
           (y (cddr x)))
58
      (let ((xcopy (make-scaffold-copy x))
sds's avatar
sds committed
59 60 61 62 63
            (ycopy (make-scaffold-copy y)))
        (and
         (tailp y x)
         (check-scaffold-copy x xcopy)
         (check-scaffold-copy y ycopy))))
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
  t)

;; Note!  The spec is ambiguous on whether this next test
;; is correct.  The spec says that tailp 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 tailp.7-body ()
  (loop
      for x in *universe*
      count (and (not (listp x))
sds's avatar
sds committed
81 82
                 (eqt 'type-error
                     (catch-type-error (tailp x x))))))
83 84 85 86 87

(deftest tailp.7
    (tailp.7-body)
  0)
|#
sds's avatar
sds committed
88

89 90 91 92 93
(deftest tailp.order.1
  (let ((i 0) x y)
    (values
     (notnot
      (tailp (progn (setf x (incf i)) 'd)
sds's avatar
sds committed
94
             (progn (setf y (incf i)) '(a b c . d))))
95 96 97
     i x y))
  t 2 1 2)