;; 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