butlast.lsp 2.48 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 22:41:14 2003
;;;; Contains: Tests of BUTLAST

(in-package :cl-test)

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

10 11 12 13
(deftest butlast.1
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((xcopy (make-scaffold-copy x)))
      (let ((result (butlast x 2)))
sds's avatar
sds committed
14 15 16
        (and
         (check-scaffold-copy x xcopy)
         result))))
17 18 19 20 21 22
  (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)))
sds's avatar
sds committed
23 24 25
        (and
         (check-scaffold-copy x xcopy)
         result))))
26 27 28 29 30 31
  (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)))
sds's avatar
sds committed
32 33 34
        (and
         (check-scaffold-copy x xcopy)
         result))))
35 36 37 38 39 40
  nil)

(deftest butlast.4
  (let ((x (list 'a 'b 'c 'd 'e)))
    (let ((xcopy (make-scaffold-copy x)))
      (let ((result (butlast x 6)))
sds's avatar
sds committed
41 42 43
        (and
         (check-scaffold-copy x xcopy)
         result))))
44 45 46 47 48 49
  nil)

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

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

54 55 56 57 58 59 60 61
(deftest butlast.7
  (butlast '(a b c d e) most-positive-fixnum)
  nil)

(deftest butlast.8
  (butlast '(a b c d e) (1- most-positive-fixnum))
  nil)

62 63
(deftest butlast.9
  (macrolet ((%m (z) z))
sds's avatar
sds committed
64 65
            (values (butlast (expand-in-current-env (%m (list 'a 'b 'c))))
                    (butlast (list 'a 'b 'c 'd 'e) (expand-in-current-env (%m 2)))))
66
  (a b)
sds's avatar
sds committed
67
  (a b c))
68

69 70 71 72
(deftest butlast.order.1
  (let ((i 0) x y)
    (values
     (butlast (progn (setf x (incf i))
sds's avatar
sds committed
73 74 75
                     (list 'a 'b 'c 'd 'e))
              (progn (setf y (incf i))
                     2))
76 77 78 79 80 81 82 83 84 85
     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)

pfdietz's avatar
pfdietz committed
86 87 88 89 90 91
(def-fold-test butlast.fold.1 (butlast '(a b) 1))
(def-fold-test butlast.fold.2 (butlast '(a b c d e f) 3))
(def-fold-test butlast.fold.3 (butlast '(a b c d e f g h i) 7))

;;; Error tests

92
(deftest butlast.error.1
93
  (signals-error (butlast (copy-tree '(a b c d)) 'a)
sds's avatar
sds committed
94
                 type-error)
95
  t)
96 97

(deftest butlast.error.2
98 99
  (signals-error (butlast 'a 0) type-error)
  t)
100 101

(deftest butlast.error.3
102 103
  (signals-error (butlast) program-error)
  t)
104 105

(deftest butlast.error.4
106 107
  (signals-error (butlast '(a b c) 3 3) program-error)
  t)
108 109

(deftest butlast.error.5
110 111 112
  (signals-error (locally (butlast 'a 0) t) type-error)
  t)

113