73 lines
2.2 KiB
Plaintext
73 lines
2.2 KiB
Plaintext
;; Function To Be Tested: REVAPPEND
|
|
;;
|
|
;; Source: Guy L Steele's CLTL
|
|
;; Section: 15.2 Lists
|
|
;; Page: 269
|
|
;;
|
|
;; Created By: Kelly Roach
|
|
;;
|
|
;; Creation Date: June 27,1986
|
|
;;
|
|
;; Last Update: June 27,1986
|
|
;; July 3, 1986 Sye / create test cases
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>15-2-REVAPPEND.TEST
|
|
;;
|
|
;;
|
|
;; Syntax: (REVAPPEND X Y)
|
|
;;
|
|
;; Function Description:
|
|
;; (REVAPPEND X Y) is exactly the same as
|
|
;; (APPEND (REVERSE X) Y) except that it is potentially more
|
|
;; efficient. Both X and Y should be lists.
|
|
;; The argument X is copied, not destroyed.
|
|
;; Compare this with function NRECONC, which destroys its first argument.
|
|
;;
|
|
;; Argument(s): X - a pure list
|
|
;; Y - a pure list
|
|
;;
|
|
;; Returns: a pure list
|
|
;;
|
|
(do-test "test revappend0"
|
|
(and (equal (revappend '(1 2) nil) '(2 1))
|
|
(equal (revappend nil '(1 2)) '(1 2))
|
|
(eq (revappend nil nil) nil)
|
|
(equal (revappend '(1 2 (3 4 (5) 6)) '(7 8)) '((3 4 (5) 6) 2 1 7 8))
|
|
(equal (revappend (revappend '(1 2 (3 4 (5) 6)) '(7 8)) '(9 10))
|
|
'(8 7 1 2 (3 4 (5) 6) 9 10))
|
|
)
|
|
)
|
|
|
|
(do-test "test revappend - For (revappend x y), The argument x is copied, not destroyed."
|
|
(progn (setf a '(1 2 3 4 5) aa a b '((1 . 2) (3 . 4) (5 . 6)) bb b c '( (( 10 9) 8 7) 6 5) cc c)
|
|
(setf aaa (revappend a b) bbb (revappend b c) ccc (revappend c a))
|
|
(and (equal a aa) (equal b bb) (equal c cc)
|
|
(equal aaa '(5 4 3 2 1 (1 . 2) (3 . 4) (5 . 6)))
|
|
(equal bbb '((5 . 6) (3 . 4) (1 . 2) (( 10 9) 8 7) 6 5))
|
|
(equal ccc '(5 6 (( 10 9) 8 7) 1 2 3 4 5))
|
|
)
|
|
)
|
|
)
|
|
|
|
(do-test "test revappend1"
|
|
(prog2
|
|
(defun fun (x y)
|
|
(let (save)
|
|
(mapcar #'(lambda (x) (push x save)) x)
|
|
(equal (revappend x y) (append save y))))
|
|
(and
|
|
(fun '(a b c d (e . "s") ( 90 100 111) ((( 3 4))) 'hi) '(the tail))
|
|
(fun '((1) ((2)) 3 4 5 6 7 8 9 10 11 (((12 13 14))) "isomorphic list" 'do 'you-understand (staghorn sumac))
|
|
'((((((((((porky pig)))))))))) )
|
|
(fun (append (make-list 50 :initial-element '(Autumn (foliage)))
|
|
(make-list 50 :initial-element '("buckthorn" (Rhamnus))))
|
|
(make-list 100 :initial-element '("The even numbers are cute, like: " (2 4 6))) )
|
|
)
|
|
)
|
|
)
|
|
;;
|
|
;;
|
|
STOP
|
|
|
|
|
|
|