source: trunk/source/tests/ansi-tests/butlast.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 2.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 19 22:41:14 2003
4;;;; Contains: Tests of BUTLAST
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10(deftest butlast.1
11  (let ((x (list 'a 'b 'c 'd 'e)))
12    (let ((xcopy (make-scaffold-copy x)))
13      (let ((result (butlast x 2)))
14        (and
15         (check-scaffold-copy x xcopy)
16         result))))
17  (a b c))
18
19(deftest butlast.2
20  (let ((x (list 'a 'b 'c 'd 'e)))
21    (let ((xcopy (make-scaffold-copy x)))
22      (let ((result (butlast x 0)))
23        (and
24         (check-scaffold-copy x xcopy)
25         result))))
26  (a b c d e))
27
28(deftest butlast.3
29  (let ((x (list 'a 'b 'c 'd 'e)))
30    (let ((xcopy (make-scaffold-copy x)))
31      (let ((result (butlast x 5)))
32        (and
33         (check-scaffold-copy x xcopy)
34         result))))
35  nil)
36
37(deftest butlast.4
38  (let ((x (list 'a 'b 'c 'd 'e)))
39    (let ((xcopy (make-scaffold-copy x)))
40      (let ((result (butlast x 6)))
41        (and
42         (check-scaffold-copy x xcopy)
43         result))))
44  nil)
45
46(deftest butlast.5
47  (butlast (copy-tree '(a b c . d)) 1)
48  (a b))
49
50(deftest butlast.6
51  (butlast '(a b c d e) (1+ most-positive-fixnum))
52  nil)
53
54(deftest butlast.7
55  (butlast '(a b c d e) most-positive-fixnum)
56  nil)
57
58(deftest butlast.8
59  (butlast '(a b c d e) (1- most-positive-fixnum))
60  nil)
61
62(deftest butlast.9
63  (macrolet ((%m (z) z))
64            (values (butlast (expand-in-current-env (%m (list 'a 'b 'c))))
65                    (butlast (list 'a 'b 'c 'd 'e) (expand-in-current-env (%m 2)))))
66  (a b)
67  (a b c))                 
68
69(deftest butlast.order.1
70  (let ((i 0) x y)
71    (values
72     (butlast (progn (setf x (incf i))
73                     (list 'a 'b 'c 'd 'e))
74              (progn (setf y (incf i))
75                     2))
76     i x y))
77  (a b c) 2 1 2)
78
79(deftest butlast.order.2
80  (let ((i 0))
81    (values
82     (butlast (progn (incf i) '(a b c d)))
83     i))
84  (a b c) 1)
85
86(def-fold-test butlast.fold.1 (butlast '(a b) 1))
87(def-fold-test butlast.fold.2 (butlast '(a b c d e f) 3))
88(def-fold-test butlast.fold.3 (butlast '(a b c d e f g h i) 7))
89
90;;; Error tests
91
92(deftest butlast.error.1
93  (signals-error (butlast (copy-tree '(a b c d)) 'a)
94                 type-error)
95  t)
96
97(deftest butlast.error.2
98  (signals-error (butlast 'a 0) type-error)
99  t)
100
101(deftest butlast.error.3
102  (signals-error (butlast) program-error)
103  t)
104
105(deftest butlast.error.4
106  (signals-error (butlast '(a b c) 3 3) program-error)
107  t)
108
109(deftest butlast.error.5
110  (signals-error (locally (butlast 'a 0) t) type-error)
111  t)
112
113
Note: See TracBrowser for help on using the repository browser.