121 lines
3.6 KiB
Plaintext
121 lines
3.6 KiB
Plaintext
;; Function To Be Tested: NBUTLAST
|
|
;;
|
|
;; 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-NBUTLAST.TEST
|
|
;;
|
|
;;
|
|
;; Syntax: (NBUTLAST LIST &OPTIONAL N)
|
|
;;
|
|
;; Function Description:
|
|
;; This is the destructive version of BUTLAST; it changes the CDR of
|
|
;; the cons N+1 from the end of the LIST to NIL. N defaults to 1.
|
|
;; If the LIST has fewer than N elements, then NBUTLAST
|
|
;; returns NIL, and the argument is not modified. (Therefore
|
|
;; one normally writes (SETQ A (NBUTLAST A)) rather than simply
|
|
;; (NBUTLAST A).)
|
|
;; For example:
|
|
;;
|
|
;; (SETQ FOO '(A B C D))
|
|
;; (NBUTLAST FOO) => (A B C)
|
|
;; FOO => (A B C)
|
|
;; (NBUTLAST '(A)) => NIL
|
|
;; (NBUTLAST 'NIL) => NIL
|
|
;;
|
|
;;
|
|
;; Argument(s): LIST - a pure list
|
|
;; N - a number
|
|
;;
|
|
;; Returns: a pure list
|
|
;;
|
|
|
|
|
|
|
|
(do-test "test nbutlast0 - test cases from page 271 of CLtL"
|
|
(and (SETQ FOO '(A B C D))
|
|
(EQUAL (NBUTLAST FOO) '(A B C))
|
|
(EQUAL FOO '(A B C))
|
|
(EQUAL (NBUTLAST '(A)) NIL)
|
|
(EQUAL (NBUTLAST NIL) NIL)))
|
|
|
|
(do-test "test nbutlast1 - if the list has fewer than n elements, then () is returned and the argument is not modified"
|
|
(every #'(lambda (x y) (let ((a x)) (and (eq nil (nbutlast x y)) (equal a x))))
|
|
'((1 2 3 4) (10 20) ((2 4) (6 8)) ((17 26 35 44))) '(5 10 3 2)))
|
|
|
|
(do-test "test nbutlast2 - n is default to 1"
|
|
(and (setq a '(a b c d e f g h i j k))
|
|
(equal (nbutlast a) '(a b c d e f g h i j))
|
|
(equal a '(a b c d e f g h i j))
|
|
;
|
|
(setq a '(foo foo1 (((((foo2 foo3)))) foo4)))
|
|
(equal (nbutlast a) '(foo foo1))
|
|
(equal a '(foo foo1))
|
|
;
|
|
(setq a (make-list 50 :initial-element 'hi))
|
|
(setq b (append (make-list 29 :initial-element 'hi) (make-list 20 :initial-element 'hi)))
|
|
(equal (nbutlast a) b)
|
|
(equal a b)
|
|
;
|
|
(setq a (nconc '(a b) '(c (d e))))
|
|
(equal (nbutlast a) '(a b c))
|
|
(equal a '(a b c))))
|
|
|
|
;;ROACH 25-JUN-86 The last (eq a ()) in this test appears to be an
|
|
;;incorrect test. A will still be bound to the value of (make-list 100).
|
|
;;I have therefore modified this test to omit the (eq a ()).
|
|
;;
|
|
(do-test "test nbutlast3"
|
|
(and (prog1 1 (setq a ()))
|
|
(eq (nbutlast a 2) ())
|
|
(eq a ())
|
|
;
|
|
(setq a '(1 2))
|
|
(equal (nbutlast a 0) '(1 2))
|
|
(equal a '(1 2))
|
|
;
|
|
(setq a '(1 2 3 4))
|
|
(eq (nbutlast a 40) ())
|
|
(equal a '(1 2 3 4))
|
|
;
|
|
(setq a (make-list 100))
|
|
(eq (nbutlast a 100) ())
|
|
;; (eq a ())
|
|
))
|
|
|
|
(do-test "test nbutlast4"
|
|
(progn
|
|
(defun fun (n)
|
|
(let ((i 0) buf)
|
|
(dotimes (i n buf) (setq buf (append buf (list i))))))
|
|
;
|
|
(and
|
|
(setq a (fun 100) b (fun 50))
|
|
(equal (nbutlast a 50) b) (equal a b)
|
|
;
|
|
(setq a (fun 20) b (fun 7))
|
|
(equal (nbutlast a 13) b) (equal a b)
|
|
;
|
|
(setq a (fun 15) b (fun 3))
|
|
(equal (nbutlast a 12) b) (equal a b))))
|
|
|
|
(do-test "test nbutlast4"
|
|
(progn (defmacro mac1 () ''*mac1*)
|
|
(defmacro mac2 () ''*mac2*)
|
|
(defmacro mac3 () ''*mac3*)
|
|
(setq a '((mac1) (mac2) (mac3)))
|
|
(and (eq (eval (cadr (nbutlast a))) '*mac2*)
|
|
(equal a '((mac1) (mac2)))
|
|
(eq (eval (car (nbutlast a))) '*mac1*)
|
|
(equal a '((mac1))) )))
|
|
|
|
|
|
STOP
|