butlast.lsp 1.75 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 22:41:14 2003
;;;; Contains: Tests of BUTLAST

(in-package :cl-test)

(deftest butlast.1
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((xcopy (make-scaffold-copy x)))
      (let ((result (butlast x 2)))
	(and
	 (check-scaffold-copy x xcopy)
	 result))))
  (a b c))

(deftest butlast.2
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((xcopy (make-scaffold-copy x)))
      (let ((result (butlast x 0)))
	(and
	 (check-scaffold-copy x xcopy)
	 result))))
  (a b c d e))

(deftest butlast.3
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((xcopy (make-scaffold-copy x)))
      (let ((result (butlast x 5)))
	(and
	 (check-scaffold-copy x xcopy)
	 result))))
  nil)

(deftest butlast.4
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((xcopy (make-scaffold-copy x)))
      (let ((result (butlast x 6)))
	(and
	 (check-scaffold-copy x xcopy)
	 result))))
  nil)

(deftest butlast.5
  (butlast (copy-tree '(a b c . d)) 1)
  (a b))

48
49
50
51
(deftest butlast.6
  (butlast '(a b c d e) (1+ most-positive-fixnum))
  nil)

52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
(deftest butlast.order.1
  (let ((i 0) x y)
    (values
     (butlast (progn (setf x (incf i))
		     (list 'a 'b 'c 'd 'e))
	      (progn (setf y (incf i))
		     2))
     i x y))
  (a b c) 2 1 2)

(deftest butlast.order.2
  (let ((i 0))
    (values
     (butlast (progn (incf i) '(a b c d)))
     i))
  (a b c) 1)

(deftest butlast.error.1
  (classify-error (butlast (copy-tree '(a b c d)) 'a))
  type-error)

(deftest butlast.error.2
  (classify-error (butlast 'a 0))
  type-error)

(deftest butlast.error.3
  (classify-error (butlast))
  program-error)

(deftest butlast.error.4
  (classify-error (butlast '(a b c) 3 3))
  program-error)

(deftest butlast.error.5
  (classify-error (locally (butlast 'a 0) t))
  type-error)