81 lines
3.1 KiB
Plaintext
81 lines
3.1 KiB
Plaintext
;; Function To Be Tested: CDADDR
|
|
;;
|
|
;; Source: Steele's book Section 15.1: Conses Page: 263
|
|
;;
|
|
;; Created By: Karin M. Sye
|
|
;;
|
|
;; Creation Date: July 18 ,1986
|
|
;;
|
|
;; Last Updaddte: July 18 ,1986
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>15-1-cdaddr.test
|
|
;;
|
|
;;
|
|
;; Syntax: CDADDR LIST
|
|
;;
|
|
;; Function Description: (CDADDR LIST) is equivalent to (CDR (CAR (CDR (CDR LIST))))
|
|
;;
|
|
;; Argument(s): LIST - a list
|
|
;;
|
|
;; Returns: anything
|
|
;;
|
|
|
|
(defun mac (list elm)
|
|
(typecase elm (number (= (cdaddr list) elm))
|
|
((or cons string) (equal (cdaddr list) elm))
|
|
(t (eq (cdaddr list) elm))
|
|
)
|
|
)
|
|
(do-test "test cdaddr0"
|
|
(prog1
|
|
(and (mac '(333 30 (1) 2 ) ())
|
|
(mac '((w) ((u)) ((1 . 2) 3 . 4) a) '(3 . 4))
|
|
(mac '(-10.0 10 (( 1 2 3 4) 5) 6 7 8 9) '(5))
|
|
(mac '((-1 y) (0 z) ( 1 a) (2 b) (3 c)) '(a))
|
|
(mac '("ha!" "e" ( ((a)) (( b))) ((c)) d) '((( b))))
|
|
(mac '("so what ?" 'foo0 (foo bar) (foo1 . bar1) ((foo2 bar2)) ((foo3) bar3) (foo4 (bar4)) (((foo5 bar5))))
|
|
'(bar))
|
|
(mac '(toe nil ((((((((( t )))))))))) () )
|
|
(mac '("fret" "china" ("excitint" "vacations" "to" |HAWAII| |Mexico| (the Pacific Northwest) ((and)) (the . Orient)))
|
|
'( "vacations" "to" |HAWAII| |Mexico| (the Pacific Northwest) ((and)) (the . Orient)))
|
|
(mac '("trill" #\% (#\F) #\o "o1" "foo2" ((foo3)) (foo4 . foo5)) () )
|
|
(mac '(guitar "bomb" (("the weather in January" ("is usually clear and sunny")) "with temperatures usually in the " fifties)
|
|
(in the daddy time) (and ) (the "20's" at night))
|
|
'("with temperatures usually in the " fifties) )
|
|
))
|
|
)
|
|
|
|
(do-test "test cdaddr1"
|
|
(progn (setq a (list #'string-upcase #'stringp (list #'null #'identity) (list #'list #'max #'min #'evenp) #'(lambda (x) (* 100 x))))
|
|
(equal (mapcar (car (cdaddr a)) (mapcar #'cdaddr '( (five 5 ()) ("fin" "hi" (1 2) 3 4) ((#\<) #\@ (#\a #\b #\c) ((#\d) #\e #\f)) ) ))
|
|
'(() (2) (#\b #\c) ))
|
|
)
|
|
)
|
|
|
|
(do-test "test cdaddr2"
|
|
(let ((aa '(0 01 (1 2 23 (3 4 45 (5 6 67 (7 8 89 (9 10 101 (11 12 123 (13 14))))))) ((((((1 2) 3 4) 5 6) 7 8) 9 10) 11 12) ) ))
|
|
(and (equal (cdaddr aa) '(2 23 (3 4 45 (5 6 67 (7 8 89 (9 10 101 (11 12 123 (13 14))))))))
|
|
(equal (cdaddr (cdaddr aa)) '( 4 45 (5 6 67 (7 8 89 (9 10 101 (11 12 123 (13 14))))) ))
|
|
(equal (cdaddr (cdaddr (cdaddr aa))) '(6 67 (7 8 89 (9 10 101 (11 12 123 (13 14))))))
|
|
(equal (cdaddr (cdaddr (cdaddr (cdaddr aa)))) '(8 89 (9 10 101 (11 12 123 (13 14)))))
|
|
(equal (cdaddr (cdaddr (cdaddr (cdaddr (cdaddr aa))))) ' (10 101 (11 12 123 (13 14))))
|
|
(equal (cdaddr (cdaddr (cdaddr (cdaddr (cdaddr (cdaddr aa)))))) '(12 123 (13 14)))
|
|
(equal (cdaddr (cdaddr (cdaddr (cdaddr (cdaddr (cdaddr (cdaddr aa))))))) '(14))
|
|
)
|
|
)
|
|
)
|
|
|
|
(do-test "test cdaddr3"
|
|
(progn (setq aa '(Q p (a b) c d ))
|
|
(and
|
|
(setf (cdaddr aa) '(8 08 (88 99 77)) )
|
|
(equal aa `(Q p ( a 8 08 (88 99 77) ) c d ))
|
|
(setf (cdaddr (cdaddr aa)) '(9 90 (3 6) 9))
|
|
(equal aa `(Q p ( a 8 08 (88 9 90 (3 6) 9) ) c d ))
|
|
(setf (cdaddr (cdaddr (cdaddr aa))) "magic kingdom")
|
|
(equal aa `(Q p ( a 8 08 (88 9 90 (3 . "magic kingdom") 9) ) c d ))
|
|
)
|
|
)
|
|
)
|
|
STOP
|