90 lines
2.4 KiB
Plaintext
90 lines
2.4 KiB
Plaintext
;; Function To Be Tested: RPLACA
|
|
;;
|
|
;; Source: Guy L Steele's CLTL
|
|
;; Section: 15.3 Alteration of List Structure
|
|
;; Page: 272
|
|
;;
|
|
;; Created By: Kelly Roach
|
|
;;
|
|
;; Creation Date: June 27,1986
|
|
;;
|
|
;; Last Update: June 27,1986
|
|
;; July 1, 1986 Sye/ create test cases
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>15-3-RPLACA.TEST
|
|
;;
|
|
;;
|
|
;; Syntax: (RPLACA X Y)
|
|
;;
|
|
;; Function Description:
|
|
;; (RPLACA X Y) changes the CAR of X to Y and returns
|
|
;; (the modified) X. X must be a cons, but Y may be any
|
|
;; Lisp object.
|
|
;; For example:
|
|
;;
|
|
;; (SETQ G '(A B C))
|
|
;; (RPLACA (CDR G) 'D) => (D C)
|
|
;; Now G => (A D C)
|
|
;;
|
|
;;
|
|
;; Argument(s): X - a list
|
|
;; Y - anything
|
|
;;
|
|
;; Returns: a list
|
|
;;
|
|
|
|
|
|
(do-test "test rplaca - test case copied from page 272 of CLtL"
|
|
(let ()
|
|
(setq g '(a b c))
|
|
(and (equal (rplaca (cdr g) 'd) '(d c)) (equal g '(a d c)))))
|
|
|
|
(do-test "test rplaca0"
|
|
(and (equal (rplaca '(a b c d) 'e) '(e b c d))
|
|
(equal (rplaca '(a b c d) #\k) '(#\k b c d))
|
|
(equal (rplaca '((a) b c d) 'e) '(e b c d))
|
|
(equal (rplaca '((((((1))))) . 2) '(3 . 6)) '((3 . 6) . 2))
|
|
(equal (rplaca '(1 2 3 . 4) ()) '( () 2 3 . 4)) ))
|
|
|
|
(do-test "test rplaca1"
|
|
(let ()
|
|
(setq a '(1 2 3 4 5))
|
|
(and
|
|
(prog2 (rplaca a (nthcdr 2 a)) (equal a '((3 4 5) 2 3 4 5)))
|
|
(prog2 (rplaca (cdar a) '(4 . 4)) (equal a '((3 (4 . 4) 5) 2 3 (4 . 4) 5)))
|
|
(prog2 (rplaca (cddar a) "hi") (equal a '((3 (4 . 4) "hi") 2 3 (4 . 4) "hi"))) )))
|
|
|
|
(do-test "test rplaca2"
|
|
(let ()
|
|
(setq ab '(5 4 3 2 1))
|
|
(rplaca (nthcdr 2 ab) (nthcdr 3 ab))
|
|
(rplaca ab (nthcdr 2 ab))
|
|
(tree-equal ab '(((2 1) 2 1) 4 (2 1) 2 1)) ))
|
|
|
|
(do-test "test rplaca3"
|
|
(prog2
|
|
(rplaca (rplaca (rplaca (rplaca (setq a '(1 2 . 3)) 'foo1) 'foo2) 'foo3) 'foo4)
|
|
(equal a '(foo4 2 . 3)) ))
|
|
|
|
(do-test "test rplaca4"
|
|
(progn (setq aa '(a b (c d (e f)) g h) aaa (append aa nil) )
|
|
(rplaca aa "bar1")
|
|
(rplaca (cdaddr aa) "bar2")
|
|
(rplaca (cdadr (cdaddr aa)) "bar3")
|
|
(and (equal aa '("bar1" b (c "bar2" (e "bar3")) g h))
|
|
(equal aaa '(a b (c "bar2" (e "bar3")) g h))
|
|
)))
|
|
|
|
(do-test "test rplaca5"
|
|
(progn (setq a (make-list 5) b '(v w x y z))
|
|
(mapcar #'(lambda(x y) (rplaca (nthcdr x a) (nthcdr y b))) '(0 1 2 3 4) '(0 1 2 3 4))
|
|
(equal a '((v w x y z) (w x y z) (x y z) (y z) (z)))
|
|
))
|
|
|
|
(do-test "test rplaca6"
|
|
(progn (setq a '(1))
|
|
(rplaca a a)
|
|
(= (list-length a ) 1)))
|
|
;;
|
|
;;
|
|
STOP |