1
0
mirror of synced 2026-05-05 15:44:25 +00:00
Files
Interlisp.medley/internal/test/LANGUAGE/AUTO/15-1-CDAR.TEST

83 lines
2.7 KiB
Plaintext

;; Function To Be Tested: CDAR
;;
;; Source: Steele's book Section 15.1: Conses Page: 263
;;
;; Created By: Karin M. Sye
;;
;; Creation Date: July 8 ,1986
;;
;; Last Update: July 8 ,1986
;;
;; Filed As: {eris}<lispcore>cml>test>15-1-cdar.test
;;
;;
;; Syntax: CDAR LIST
;;
;; Function Description: If the first element of LIST is a list, CAAR returns the second element of the sublist.
;;
;; Argument(s): LIST - a list
;;
;; Returns: anything
;;
(defun mac (list elm)
(typecase elm (number (= (cdar list) elm))
((or cons string) (equal (cdar list) elm))
(t (eq (cdar list) elm))
)
)
(do-test "test cdar0"
(prog1
(and (mac '((1) 2 ) ())
(mac '(((1 . 2) 3 . 4) a) '(3 . 4))
(mac '((( 1 2 3 4) 5) 6 7 8 9) '(5))
(mac '(( 1 a) (2 b) (3 c)) '(a))
(mac '(( ((a)) (( b))) ((c)) d) '((( b))))
(mac '((foo bar) (foo1 . bar1) ((foo2 bar2)) ((foo3) bar3) (foo4 (bar4)) (((foo5 bar5))))
'(bar))
(mac '(((((((((( t )))))))))) () )
(mac '( ("excitint" "vacations" "to" |HAWAII| |Mexico| (the Pacific Northwest) ((and)) (the . Orient)))
'("vacations" "to" |HAWAII| |Mexico| (the Pacific Northwest) ((and)) (the . Orient)))
(mac '((#\F) #\o "o1" "foo2" ((foo3)) (foo4 . foo5)) () )
(mac '((("the weather in January" ("is usually clear and sunny")) "with temperatures usually in the " fifties)
(in the day time) (and ) (the "20's" at night))
'("with temperatures usually in the " fifties) )
))
)
(do-test "test cdar1"
(progn (setq a (list (list #'null #'identity) (list #'list #'max #'min #'evenp) #'(lambda (x) (* 100 x))))
(equal (mapcar (car (cdar a)) (mapcar #'cdar '( (()) ((1 2) 3 4) ((#\a #\b #\c) ((#\d) #\e #\f)) ) ))
'(() (2) (#\b #\c) ))
)
)
(do-test "test cdar2"
(let ((aa '((1 (3 (5 (7 (9 (11 (13 14))))))) ((((((1 2) 3 4) 5 6) 7 8) 9 10) 11 12) ) ))
(and (equal (cdar aa) '((3 (5 (7 (9 (11 (13 14))))))))
(equal (cdar (cdar aa)) '( (5 (7 (9 (11 (13 14))))) ))
(equal (cdar (cdar (cdar aa))) '((7 (9 (11 (13 14))))))
(equal (cdar (cdar (cdar (cdar aa)))) '((9 (11 (13 14)))))
(equal (cdar (cdar (cdar (cdar (cdar aa))))) '((11 (13 14))))
(equal (cdar (cdar (cdar (cdar (cdar (cdar aa)))))) '((13 14)))
(equal (cdar (cdar (cdar (cdar (cdar (cdar (cdar aa))))))) '(14))
)
)
)
(do-test "test cdar3"
(progn (setq aa '((a b) c d ))
(and
(setf (cdar aa) (make-list 2 :initial-element '(2 4)))
(equal aa `(( a (2 4) (2 4)) c d ))
(setf (cdar (cdar aa)) '((3 6) 9))
(equal aa `(( a (2 (3 6) 9) (2 (3 6) 9)) c d ))
(setf (cdar (cdar (cdar aa))) "magic kingdom")
(equal aa `(( a (2 (3 . "magic kingdom") 9) (2 (3 . "magic kingdom") 9)) c d ))
)
)
)
;;
;;
STOP