94 lines
3.0 KiB
Plaintext
94 lines
3.0 KiB
Plaintext
;; Function To Be Tested: SIXTH
|
|
;;
|
|
;; Source: Guy L Steele's CLTL
|
|
;; Section: 15.2 Lists
|
|
;; Page: 266
|
|
;;
|
|
;; Created By: Kelly Roach
|
|
;;
|
|
;; Creation Date: July 3,1986
|
|
;; July 3, 1986 Sye/ create test cases
|
|
;;
|
|
;; Last Update: July 3,1986
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>15-2-SIXTH.TEST
|
|
;;
|
|
;;
|
|
;; Syntax: (SIXTH LIST)
|
|
;;
|
|
;; Function Description:
|
|
;; These functions are sometimes convenient for accessing particular
|
|
;; elements of a list. FIRST is the same as function CAR,
|
|
;; SECOND is the same as CADR, THIRD is the
|
|
;; same as CADDR, and so on.
|
|
;; Note that the ordinal numbering used here is one-origin,
|
|
;; as opposed to the zero-origin numbering used by function NTH:
|
|
;;
|
|
;; (SIXTH X) = (NTH 6 X)
|
|
;;
|
|
;;
|
|
;; macro SETF may be used with each of these functions to store
|
|
;; into the indicated position of a list.
|
|
;;
|
|
;; Argument(s): LIST - a list
|
|
;;
|
|
;; Returns: anything
|
|
;;
|
|
|
|
(do-test "test sixth0"
|
|
(and (eq (sixth ()) ())
|
|
(eq (sixth '(1)) ())
|
|
(eq (sixth '(1 2)) ())
|
|
(eq (sixth '(1 2 3)) ())
|
|
(eq (sixth '(1 2 3 4)) ())
|
|
(eq (sixth '(1 2 3 4 5)) ())
|
|
(eq (sixth '(1 2 3 4 5 6)) 6)
|
|
(eq (sixth '(a b c d e f g)) 'f)
|
|
(equal (sixth '(nil nil nil t t (nil . t) non-nil)) '(nil . t))
|
|
))
|
|
|
|
(do-test "test sixth1"
|
|
(and (eq (sixth '(Do a deer a female deer !!)) 'deer)
|
|
(equal (sixth '("Re" "a" "drop" "of" "golden" "sun---nn" ! ! !)) "sun---nn")
|
|
(equal (sixth '((Mi) (a) (name) (i . call) (myself) (Fa a (long logn .way) to . run) nil))
|
|
'(Fa a (long logn .way) to . run))
|
|
(eq (sixth '(|So| #\a |needle| "...." Oh! #\I |forgot|)) #\I)
|
|
(equal (sixth '( A needle pulling thread "yes !" ((((((a) needle) pulling) "thread") "--") . "--ead")))
|
|
'((((((a) needle) pulling) "thread") "--") . "--ead") )
|
|
(equal (sixth '((so . how) (do . you) (like . my) (do . re) (mi . fa) (so la ti ( and . do) ?? ) ) )
|
|
'(so la ti ( and . do) ??) )
|
|
)
|
|
)
|
|
|
|
(do-test "test sixth2"
|
|
(prog2
|
|
(defmacro mac (list elm)
|
|
`(typecase ,elm (number (= (sixth ,list) ,elm))
|
|
((or cons string) (equal (sixth ,list) ,elm))
|
|
(t (eq (sixth ,list) ,elm))
|
|
)
|
|
)
|
|
(and (mac '(New Mail for Sye dot pasa xsis xerox) 'pasa)
|
|
(mac (make-list 5) nil)
|
|
(mac (sixth '(1 2 3 4 5 (10 20 30 40 50 60 70 80) 7 8 9)) 60)
|
|
(mac (sixth (sixth (sixth (sixth '(a b c d e (1 2 3 4 5 (11 22 33 44 55 ( 111 222 333 444 555
|
|
(aa bb cc dd ee (ff . gg) hh ii) 777) 77) 7) gg) )))) '(ff . gg))
|
|
(mac '(blackberries "monroe" (county) (tennessee . olympus) om-2 ((with 90mm . macro)
|
|
(lenx . kodachrome) . peter) 'arnold 'inc) '((with 90mm . macro) (lenx . kodachrome) . peter))
|
|
))
|
|
)
|
|
|
|
(do-test "test sixth - using setf and rplacd with sixth"
|
|
(progn (setq list (list #'+ #'- #'* #'= #'<= #'max #'equalp))
|
|
(setq aa (mapcar #'(lambda (x) (funcall x 10 20)) list))
|
|
(eq (sixth aa) 20)
|
|
(setf (sixth list) #'cons)
|
|
(setq aa (mapcar #'(lambda (x) (funcall x 10 20)) list))
|
|
(equal (sixth aa) '(10 . 20))
|
|
(rplacd (sixth aa) "end of testing")
|
|
(equal (sixth aa) '(10 . "end of testing"))
|
|
)
|
|
)
|
|
|
|
STOP
|