124 lines
4.7 KiB
Plaintext
124 lines
4.7 KiB
Plaintext
;; Function To Be Tested: cond
|
|
;;
|
|
;; Source: Steele's book Section 7.6: Conditionals Page: 116
|
|
;;
|
|
;; Created By: Karin M. Sye
|
|
;;
|
|
;; Creation Date: June 11,1986
|
|
;;
|
|
;; Last Update: June 11,1986
|
|
;; June 17, 1986 Sye/ change "set 'm ..." to "setq m ..." in "test cond - test the selected final clause"
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>7-6-cond.test
|
|
;;
|
|
;;
|
|
;; Syntax: COND {(test {form}*)}*
|
|
;;
|
|
;; Function Description: COND processes its clauses from left to right and selects the first clause whose test is
|
|
;; non-nil. The forms (consequents) of the selected clause are evaluated in order (as an
|
|
;; implicit progn) and the value(s) of the last form evaluated is returned and the remaining
|
|
;; clauses are ignored.
|
|
;;
|
|
;; Argument(s): form - a lisp data object meant to be evaluated to produce one or more values
|
|
;; test - a form which returns nil or non-nil
|
|
;;
|
|
;; Returns: value(s) of the last evaluated form of the selected clause
|
|
;;
|
|
|
|
(do-test "test cond - zero clause"
|
|
(eq nil (cond)))
|
|
|
|
(do-test "test cond - zero form"
|
|
(and (= (cond (1)) 1)
|
|
(= (cond (nil)
|
|
(2)) 2)
|
|
(eq (cond (nil)
|
|
((cdr '(1)))
|
|
((and t nil))
|
|
((or nil nil))
|
|
('())
|
|
('non-nil)) 'non-nil)))
|
|
|
|
(do-test "test cond0"
|
|
(eq (cond ((oddp 20) (1+ 20))
|
|
((evenp 3) (1- 3))
|
|
((= (sqrt #18r10000) #18r100) 18)
|
|
(t 180)) 18))
|
|
|
|
(do-test "test cond1"
|
|
(equal (cond ((equal '(1 2 3) (list 1 2 3 4)) "err1")
|
|
((and 'a 'b nil) "err2")
|
|
((prog1 2) "2")
|
|
((prog1 3) "3")) "2"))
|
|
|
|
(do-test "test cond2"
|
|
(progn (defun fun (x y) (cond ((evenp x) nil) (t y)))
|
|
(equal (cond ((fun 2 4) "err1")
|
|
((fun 10 9) "err2")
|
|
((fun 1000 'a) "err3")
|
|
(t (fun -1 "gotcha"))) "gotcha")))
|
|
|
|
(do-test "test cond3 - test nested cond"
|
|
(let (object)
|
|
(defun otype (object)
|
|
(cond ((numberp object)
|
|
(cond ((plusp object) (cond ((>= object 100) ">= 100")
|
|
(t "< 100 +")))
|
|
((zerop object) (cond ("= 0")))
|
|
((minusp object) (cond ((>= object -100) ">= -100 -")
|
|
(t "< -100")))
|
|
(t "error1")))
|
|
((listp object)
|
|
(cond ((eq object nil) "nil")
|
|
(t "list")))
|
|
(t "non-number-non-list")))
|
|
(and
|
|
(equal (otype 101) ">= 100")
|
|
(equal (otype nil) "nil")
|
|
(equal (otype 'a) "non-number-non-list")
|
|
(equal (otype (1- 1)) "= 0")
|
|
(equal (otype (/ -400 2)) "< -100"))))
|
|
|
|
|
|
|
|
(do-test "test cond - test for returning multiple values"
|
|
(let ()
|
|
(defun fun1 (x y)
|
|
(multiple-value-list (cond ((= x 1) (values-list y))
|
|
((= x 2) (values-list (mapcar #'(lambda (z) (* z 2)) y)))
|
|
((= x 3) (values-list (mapcar #'(lambda (z) (* z 3)) y)))
|
|
(t (values 'sorry 'wrong 'input)))))
|
|
(and
|
|
(equal (fun1 1 '(1 2)) '(1 2))
|
|
(equal (fun1 3 (list 10 20 30)) '(30 60 90))
|
|
(equal (fun1 10 '(9)) '(sorry wrong input))
|
|
(equal (fun1 (* 2 1.0) (cons 9 (cons 7 (cons 5 (cons 3 nil))))) '(18 14 10 6)))))
|
|
|
|
(do-test "test cond - a selected singleton clause returns only a single value (p 138 of CLtL)"
|
|
(let (fail a b)
|
|
(multiple-value-setq (a b) (cond (fail 1)
|
|
(fail 2)
|
|
((values 999 99 9))
|
|
((not fail) 100)))
|
|
(and (= a 999) (eq b nil))))
|
|
|
|
|
|
(do-test "test cond - test the selected final clause"
|
|
(let (fail m)
|
|
;
|
|
; if the selected final clause is a singleton clause, be sure only a single value was returned
|
|
;
|
|
(and (setq m (multiple-value-list (cond (fail 1)
|
|
(fail 100)
|
|
((values-list (list 66 33 22))))))
|
|
(equal m '(66))
|
|
;
|
|
; if the selected final clause has a test part (non-nil), any value(s) may be returned
|
|
;
|
|
(equal (multiple-value-list (cond (fail 10)
|
|
(fail 100)
|
|
((or fail 1) (values-list (list 2 4 6 8 10)))))
|
|
'(2 4 6 8 10) ))))
|
|
;;
|
|
;;
|
|
STOP |