nbutlast.lsp 2.43 KB
Newer Older
1 2
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
3 4
;;;; Created:  Sat Apr 19 22:41:54 2003
;;;; Contains: Tests of NBUTLAST
5 6

(in-package :cl-test)
7

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

10
(deftest nbutlast.1
11 12
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((y (cdr x))
sds's avatar
sds committed
13
          (z (cddr x)))
14
      (let ((result (nbutlast x 2)))
sds's avatar
sds committed
15 16 17 18
        (and (eqt x result)
             (eqt (cdr x) y)
             (eqt (cddr x) z)
             result))))
19 20
  (a b c))

21
(deftest nbutlast.2
22 23 24
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((result (nbutlast x 5)))
      (list x result)))
25 26
  ((a b c d e) nil))

27
(deftest nbutlast.3
28 29 30
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((result (nbutlast x 500)))
      (list x result)))
31 32
  ((a b c d e) nil))

33
(deftest nbutlast.4
34 35 36
  (let ((x (list* 'a 'b 'c 'd)))
    (let ((result (nbutlast x 1)))
      (and (eqt result x)
sds's avatar
sds committed
37
           result)))
38 39
  (a b))

40 41 42 43 44 45 46 47
(deftest nbutlast.5
  (nbutlast nil)
  nil)

(deftest nbutlast.6
  (nbutlast (list 'a))
  nil)

48 49 50 51
(deftest nbutlast.7
  (nbutlast (list 'a 'b 'c 'd) (1+ most-positive-fixnum))
  nil)

52 53 54 55 56 57 58 59
(deftest nbutlast.8
  (nbutlast (list 'a 'b 'c 'd) most-positive-fixnum)
  nil)

(deftest nbutlast.9
  (nbutlast (list 'a 'b 'c 'd) (1- most-positive-fixnum))
  nil)

60
(deftest nbutlast.order.1
61 62 63
  (let ((i 0) x y)
    (values
     (nbutlast (progn (setf x (incf i))
sds's avatar
sds committed
64 65 66
                      (list 'a 'b 'c 'd 'e))
               (progn (setf y (incf i))
                      2))
67 68 69
     i x y))
  (a b c) 2 1 2)

70 71 72 73 74 75 76
(deftest nbutlast.order.2
  (let ((i 0))
    (values
     (nbutlast (progn (incf i) (list 'a 'b 'c 'd)))
     i))
  (a b c) 1)

77 78
;;; Error tests

79
(deftest nbutlast.error.1
80
  (signals-error (let ((x (list* 'a 'b 'c 'd))) (nbutlast x 'a))
sds's avatar
sds committed
81
                 type-error)
82
  t)
83

84
(deftest nbutlast.error.2
85 86
  (signals-error (nbutlast 'a 10) type-error)
  t)
87

88
(deftest nbutlast.error.3
89 90
  (signals-error (nbutlast 2 10) type-error)
  t)
91

92
(deftest nbutlast.error.4
93 94
  (signals-error (nbutlast #\w 10) type-error)
  t)
95

96
(deftest nbutlast.error.5
97 98
  (signals-error (nbutlast (list 'a 'b 'c 'd) -3) type-error)
  t)
99

100
(deftest nbutlast.error.6
101 102
  (signals-error (nbutlast (list 'a) 20.0) type-error)
  t)
103

104
(deftest nbutlast.error.7
105 106
  (signals-error (nbutlast (list 'a) -100.0) type-error)
  t)
107

108
(deftest nbutlast.error.8
109 110
  (signals-error (nbutlast) program-error)
  t)
111

112
(deftest nbutlast.error.9
113 114
  (signals-error (nbutlast (list 'a 'b 'c) 3 3) program-error)
  t)
115

116
(deftest nbutlast.error.10
117 118
  (signals-error (locally (nbutlast 'a 10) t) type-error)
  t)