100 lines
3.3 KiB
Plaintext
100 lines
3.3 KiB
Plaintext
;; Function To Be Tested: cdr-and-rest
|
|
;;
|
|
;; Source: Steele's book Section 15.1: Conses Page: 262 & 266
|
|
;;
|
|
;; Created By: Karin M. Sye
|
|
;;
|
|
;; Creation Date: June 30,1986
|
|
;;
|
|
;; Last Update: June 30,1986
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>15-1-cdr-and-rest.test
|
|
;;
|
|
;;
|
|
;; Syntax: CDR list
|
|
;; REST list
|
|
;;
|
|
;; Function Description: CDR returns a list with all elements but the first of the original list.
|
|
;;
|
|
;; Argument(s): list
|
|
;;
|
|
;; Returns: a list
|
|
;;
|
|
(do-test "test cdr - the cdr of () is ()"
|
|
(eq (cdr ()) ())
|
|
)
|
|
|
|
(do-test "test cdr0 - argument is a true list"
|
|
(and (equal (cdr '(a b c)) '(b c))
|
|
(equal (cdr (make-list 20 :initial-element 'quack)) (make-list 19 :initial-element 'quack))
|
|
(equal (cdr (cdr (cdr (cdr (cdr (cdr (cdr '(((((( 4 5)))))) ))))))) ())
|
|
(equal (cdr (cdr (cdr '((a b c d (e f (g h i j)) (k l m)) o p q r (s t))))) '(q r (s t)) )
|
|
(setq a (list 1 #'+))
|
|
(= (funcall (car (cdr a)) 1 2 3 4 5 ) 15)
|
|
))
|
|
|
|
(do-test "test cdr1 - argument is a dotted list"
|
|
(and (eq (cdr '(nil . nil)) nil)
|
|
(equal (cdr '((1 2 3 4 5 6) . "s")) "s")
|
|
(equal (cdr (cdr (cdr (cdr '( () () () () ( () () () () (()) . nil)))))) '(( () () () () (()) . nil)) )
|
|
(equal (cdr (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 6)))))) '(2 3 4 5 . 6))
|
|
))
|
|
|
|
(do-test "test cdr2 - the cdr of a cons may be altered by using rplacd or setf"
|
|
(let ()
|
|
(setq aa '(a b c d (e f) g h (i j k)))
|
|
(and (rplacd (cdr (car (last aa))) '(l m))
|
|
(equal aa '(a b c d (e f) g h (i j l m) ))
|
|
(rplacd (cdr aa) (nthcdr 5 aa))
|
|
(equal aa '(a b g h (i j l m)))
|
|
(setf (cdr aa) "the end")
|
|
(equal aa '(a . "the end"))
|
|
)
|
|
)
|
|
)
|
|
|
|
;
|
|
; Function "rest" should behave the same as "cdr"
|
|
; The following test cases are the duplicates of the above ones, except the function "cdr" was replaced by "rest"
|
|
;
|
|
(do-test "test rest - the rest of () is ()"
|
|
(eq (rest ()) ())
|
|
)
|
|
|
|
(do-test "test rest0 - argument is a true list"
|
|
(and (equal (rest '(a b c)) '(b c))
|
|
(equal (rest (make-list 20 :initial-element 'quack)) (make-list 19 :initial-element 'quack))
|
|
(equal (rest (rest (rest (rest (rest (rest (rest '(((((( 4 5)))))) ))))))) ())
|
|
(equal (rest (rest (rest '((a b c d (e f (g h i j)) (k l m)) o p q r (s t))))) '(q r (s t)) )
|
|
(setq a (list 1 #'+))
|
|
(= (funcall (car (rest a)) 1 2 3 4 5 ) 15)
|
|
))
|
|
|
|
(do-test "test rest1 - argument is a dotted list"
|
|
(and (eq (rest '(nil . nil)) nil)
|
|
(equal (rest '((1 2 3 4 5 6) . "s")) "s")
|
|
(equal (rest (rest (rest (rest '( () () () () ( () () () () (()) . nil)))))) '(( () () () () (()) . nil)) )
|
|
(equal (rest (cons 1 (cons 2 (cons 3 (cons 4 (cons 5 6)))))) '(2 3 4 5 . 6))
|
|
))
|
|
|
|
(do-test "test rest2 - the rest of a cons may be altered by using rplacd or setf"
|
|
(let ()
|
|
(setq aa '(a b c d (e f) g h (i j k)))
|
|
(and (rplacd (rest (car (last aa))) '(l m))
|
|
(equal aa '(a b c d (e f) g h (i j l m) ))
|
|
(rplacd (rest aa) (nthcdr 5 aa))
|
|
(equal aa '(a b g h (i j l m)))
|
|
(setf (rest aa) "the end")
|
|
(equal aa '(a . "the end"))
|
|
)
|
|
)
|
|
)
|
|
;;
|
|
;;
|
|
STOP
|
|
|
|
|
|
|
|
|
|
|