81 lines
2.5 KiB
Plaintext
81 lines
2.5 KiB
Plaintext
;; Function To Be Tested: BUTLAST
|
|
;;
|
|
;; Source: Guy L Steele's CLTL
|
|
;; Section: 15.2 Lists
|
|
;; Page: 271
|
|
;;
|
|
;; Created By: Karin M. Sye, Kelly Roach
|
|
;;
|
|
;; Creation Date: June 27,1986
|
|
;;
|
|
;; Last Update: June 27,1986
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>15-2-BUTLAST.TEST
|
|
;;
|
|
;;
|
|
;; Syntax: (BUTLAST LIST &OPTIONAL N)
|
|
;;
|
|
;; Function Description:
|
|
;; This creates and returns a list with the same elements as LIST,
|
|
;; excepting the last N elements.
|
|
;; N defaults to 1. The argument is not destroyed.
|
|
;; If the LIST has fewer than N elements, then NIL is returned.
|
|
;; For example:
|
|
;;
|
|
;; (BUTLAST '(A B C D)) => (A B C)
|
|
;; (BUTLAST '((A B) (C D))) => ((A B))
|
|
;; (BUTLAST '(A)) => NIL
|
|
;; (BUTLAST NIL) => NIL
|
|
;;
|
|
;; The name is from the phrase ``all elements but the last.''
|
|
;;
|
|
;; Argument(s): LIST - a list
|
|
;; N - a number
|
|
;;
|
|
;; Returns: a pure list
|
|
;;
|
|
|
|
|
|
|
|
(do-test "test butlast0 - test cases copied from page 271 of CLtL"
|
|
(and (equal (butlast '(a b c d)) '(a b c))
|
|
(equal (butlast '((a b) (c d))) '((a b)))
|
|
(eq (butlast '(a)) ())
|
|
(eq (butlast ()) ())))
|
|
|
|
(do-test "test butlast1 - if the list has fewer than n elements, then () is returned"
|
|
(notany #'(lambda (x &optional y) (butlast x y)) '((1 2 3 4) (10 20) ((2 4) (6 8)) ((17 26 35 44)))
|
|
'(5 10 3 2)))
|
|
|
|
(do-test "test butlast2 - n is default to 1"
|
|
(and (equal (butlast '(a b c d e f g h i j k)) '(a b c d e f g h i j))
|
|
(equal (butlast '(foo foo1 (((((foo2 foo3)))) foo4))) '(foo foo1))
|
|
(equal (butlast (make-list 50 :initial-element 'hi)) (append (make-list 29 :initial-element 'hi)
|
|
(make-list 20 :initial-element 'hi)))
|
|
(equal (butlast (nconc '(a b) '(c (d e)))) '(a b c))))
|
|
|
|
(do-test "test butlast3"
|
|
(and (eq (butlast () 2) ())
|
|
(equal (butlast '(1 2) 0) '(1 2))
|
|
(eq (butlast '(1 2 3 4) 40) ())
|
|
(eq (butlast (make-list 100) 100) ())
|
|
;
|
|
(defun fun (n)
|
|
(let ((i 0) buf)
|
|
(dotimes (i n buf) (setq buf (append buf (list i))))))
|
|
;
|
|
(equal (butlast (fun 100) 50) (fun 50))
|
|
(equal (butlast (fun 20) 13) (fun 7))
|
|
(equal (butlast (fun 15) 12) (fun 3))))
|
|
|
|
(do-test "test butlast4"
|
|
(progn (defmacro mac1 () ''*mac1*)
|
|
(defmacro mac2 () ''*mac2*)
|
|
(defmacro mac3 () ''*mac3*)
|
|
(setq a '((mac1) (mac2) (mac3)))
|
|
(and (eq (eval (cadr (butlast a))) '*mac2*)
|
|
(eq (eval (car (butlast (reverse a)))) '*mac3*))))
|
|
|
|
|
|
STOP
|