source: trunk/source/tests/ansi-tests/tailp.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: 2.0 KB
RevLine 
[8991]1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 19 22:47:26 2003
4;;;; Contains: Tests of TAILP
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest tailp.1
11  (let ((x (copy-tree '(a b c d e . f))))
12    (and
13     (tailp x x)
14     (tailp (cdr x) x)
15     (tailp (cddr x) x)
16     (tailp (cdddr x) x)
17     (tailp (cddddr x) x)
18     t))
19  t)
20
21;; The next four tests test that tailp handles dotted lists.  See
22;; TAILP-NIL:T in the X3J13 documentation.
23
24(deftest tailp.2
25  (notnot-mv (tailp 'e (copy-tree '(a b c d . e))))
26  t)
27
28(deftest tailp.3
29  (tailp 'z (copy-tree '(a b c d . e)))
30  nil)
31
32(deftest tailp.4
33  (notnot-mv (tailp 10203040506070
34                    (list* 'a 'b (1- 10203040506071))))
35  t)
36
37(deftest tailp.5
38  (let ((x "abcde")) (tailp x (list* 'a 'b (copy-seq x))))
39  nil)
40
41(deftest tailp.error.5
42  (signals-error (tailp) program-error)
43  t)
44
45(deftest tailp.error.6
46  (signals-error (tailp nil) program-error)
47  t)
48
49(deftest tailp.error.7
50  (signals-error (tailp nil nil nil) program-error)
51  t)
52
53;; Test that tailp does not modify its arguments
54
55(deftest tailp.6
56    (let* ((x (copy-list '(a b c d e)))
57           (y (cddr x)))
58      (let ((xcopy (make-scaffold-copy x))
59            (ycopy (make-scaffold-copy y)))
60        (and
61         (tailp y x)
62         (check-scaffold-copy x xcopy)
63         (check-scaffold-copy y ycopy))))
64  t)
65
66;; Note!  The spec is ambiguous on whether this next test
67;; is correct.  The spec says that tailp should be prepared
68;; to signal an error if the list argument is not a proper
69;; list or dotted list.  If listp is false, the list argument
70;; is neither (atoms are not dotted lists).
71;;
72;; However, the sample implementation *does* work even if
73;; the list argument is an atom.
74;;
75
76#|
77(defun tailp.7-body ()
78  (loop
79      for x in *universe*
80      count (and (not (listp x))
81                 (eqt 'type-error
82                     (catch-type-error (tailp x x))))))
83
84(deftest tailp.7
85    (tailp.7-body)
86  0)
87|#
88   
89(deftest tailp.order.1
90  (let ((i 0) x y)
91    (values
92     (notnot
93      (tailp (progn (setf x (incf i)) 'd)
94             (progn (setf y (incf i)) '(a b c . d))))
95     i x y))
96  t 2 1 2)
97
Note: See TracBrowser for help on using the repository browser.