142 lines
4.0 KiB
Plaintext
142 lines
4.0 KiB
Plaintext
;; Function To Be Tested: case
|
|
;;
|
|
;; Source: Steele's book
|
|
;; Section 7.6: Conditionals
|
|
;; Page: 117
|
|
;;
|
|
;; Created By: Bob Bane
|
|
;; Henry Cate III
|
|
;;
|
|
;; Creation Date: June 26,1986
|
|
;;
|
|
;; Last Update: June 26,1986
|
|
;; October 13,1986 HC3/ documented, and added
|
|
;; several more test cases
|
|
;; October 24,1986 HC3/ broke into smaller tests.
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>7-6-CASE.TEST
|
|
;;
|
|
;;
|
|
;; Syntax: (case keyform {({({key}*)|key}{form}*)}*)
|
|
;;
|
|
;;
|
|
;; Function Description:
|
|
;; The form keyform is evaluated to produce the key object.
|
|
;; The key is matched against each clause to see if the key is
|
|
;; in the keylist. The forms of that cluase are evaluated, and
|
|
;; case returns what was returned from the last consequent (or
|
|
;; nil if there are none for that clause.
|
|
;;
|
|
;;
|
|
;;
|
|
;; Argument(s): KEYFORM - evaluated to build a key object
|
|
;; KEY - a list of one or more keys.
|
|
;; FORM - what is evaluated.
|
|
;;
|
|
;; Returns: value(s) of the last evaluated form of
|
|
;; the selected clause
|
|
;;
|
|
|
|
|
|
|
|
(do-test "Do some simple tests"
|
|
(and
|
|
; Does case evaluate and return the appropriate things?
|
|
(case T (T T)) ; catch everthing
|
|
(case T (nil nil) (T T)) ; catch everthing
|
|
(case T (nil nil) (nil nil) (T T)) ; catch everthing
|
|
(eq (case T (nil T)) nil)
|
|
(eq (case T (T nil)) nil) ; catch everthing
|
|
(eq (case T (T)) nil)
|
|
))
|
|
|
|
|
|
(do-test "Do some work in creating keyform"
|
|
(and
|
|
; do some work inside
|
|
(case (< 10 13) (T T))
|
|
(case (< 10 13) (T (> 13 10)))
|
|
(case (< 10 3) (T T)) ; catch everthing
|
|
(eq (case (< 10 13) (nil T)) nil)
|
|
))
|
|
|
|
|
|
(do-test "Check we can use symbols in the keyform"
|
|
(and
|
|
(case 'foo (foo T) (T nil))
|
|
(case 'foo (bar nil) (foo T) (T nil))
|
|
(eq (case 'foo (bar T)) nil)
|
|
(eq (case 'foo (bar T) (5 T)) nil)
|
|
))
|
|
|
|
|
|
(do-test "Check we can use numbers in the keyform"
|
|
(and
|
|
(case (* 5 6) (30 T))
|
|
(case (* 5 6) ((20 30) T))
|
|
(case (* 3 10) (5 nil) ((4 5 6) nil) ((20 30) T))
|
|
(case (/ 3 10) (5 nil) ((2/10 4/10) nil) ((3/10) T))
|
|
))
|
|
|
|
|
|
(do-test "Can case return multiple values?"
|
|
(and
|
|
(let ((casevar 'foo))
|
|
(equal (multiple-value-list
|
|
(case casevar
|
|
(foo (values 'x 'y))
|
|
(t nil)))
|
|
'(x y)))
|
|
))
|
|
|
|
|
|
(do-test "Check values set in CASE still good outside"
|
|
; Define a function, tee returning T
|
|
(flet ((tee nil t))
|
|
(let ((casevar 'foo)(sideffect nil))
|
|
(and
|
|
; Check values set withinside of CASE
|
|
; are still set outside of CASE
|
|
(case (tee) (T (setq sideffect T)))
|
|
(eq sideffect T)
|
|
(case 'foo (nil nil) (hi nil)
|
|
(foo (setq sideffect 'foo) T) (T nil))
|
|
(eq sideffect 'foo)
|
|
(eq (case casevar
|
|
(bar (setq sideffect 'nope))
|
|
((foo baz) (setq sideffect 'winner) 'okay)
|
|
(otherwise (setq sideffect 'lose) 'so-what))
|
|
'okay)
|
|
(eq sideffect 'winner)
|
|
(eq (case (* 5 5) (5 nil) ((10 20 53) nil)
|
|
((1 2 3 4 25) (setq sideffect 5)) (T nil))
|
|
5)
|
|
(eq sideffect 5)
|
|
))))
|
|
|
|
|
|
(do-test "Check values set in CASE still good outside"
|
|
; check the path not taken was in fact not taken
|
|
(flet ((tee nil t))
|
|
(let ((sideffect nil))
|
|
(and
|
|
(eq (case (tee) (nil (setq sideffect T))) nil)
|
|
(eq sideffect nil)
|
|
(eq (case 'foo (nil (setq sideffect 'nil))
|
|
(hi (setq sideffect 'he))
|
|
(bar (setq sideffect 'foo) T)
|
|
(T 'everythingelse))
|
|
'everythingelse)
|
|
(eq sideffect nil)
|
|
(eq (case (* 5 5)
|
|
(5 (setq sideffect 5))
|
|
((10 20 53) (setq sideffect 104))
|
|
((1 2 3 4 6) (setq sideffect 65))
|
|
(T (* 2 3 4)))
|
|
24)
|
|
(eq sideffect nil)
|
|
))))
|
|
|
|
|
|
STOP
|