136 lines
4.3 KiB
Plaintext
136 lines
4.3 KiB
Plaintext
;; Function To Be Tested: flet
|
|
;;
|
|
;; Source: CLtL Section 7.5: Establishing New Variable Bindings Page: 113
|
|
;;
|
|
;; Created By: Karin M. Sye
|
|
;;
|
|
;; Creation Date: Oct. 25 ,1986
|
|
;;
|
|
;; Last Update: Oct. 25 ,1986
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>7-5-flet.test
|
|
;;
|
|
;;
|
|
;; Syntax: flet ({(NAME LAMBDA-LIST {DECLARATION | DOC-STRING}* {FORM}*)}*) {FORM}*
|
|
;;
|
|
;; Function Description: flet may be used to define locally named functions. Within the body of the flet form, function names
|
|
;; matching those defined by the flet refer to the locally defined functions rather than to the global
|
|
;; function definitions of the same name. Any number of functions may be simultaneously defined.
|
|
;; Each definition is similar in format to a defun form. Using flet one can locally redefine a global function
|
|
;; name, and the new definition can refer to the global definition.
|
|
;;
|
|
;; Argument(s): NAME - a function name
|
|
;; LAMBDA-LIST -
|
|
;; DECLARATION -
|
|
;; DOC-STRING - a string
|
|
;; FORM -
|
|
;;
|
|
;; Returns: anything
|
|
;;
|
|
|
|
(do-test "test flet - test case copied from page 113 of CLtL"
|
|
|
|
(flet ((safesqrt (x) (sqrt (abs x)) ))
|
|
;;
|
|
;; The safesqrt function is used in two places
|
|
;;
|
|
(let ( (longlist1 '(1 4 -25 100 -144)) (longlist2 '(10000 -25 9 16 -36)) (longlist3 '( -1.21 4.84 -10.89 19.36 -30.25)) )
|
|
(and
|
|
(= (safesqrt (apply #'+ (map 'list #'safesqrt longlist1))) (sqrt 30))
|
|
(= (safesqrt (apply #'+ (map 'list #'safesqrt longlist2))) (sqrt 118))
|
|
(= (safesqrt (apply #'+ (map 'list #'safesqrt longlist3))) (sqrt 16.5))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(do-test "test flet - with empty flet bodies"
|
|
|
|
(and
|
|
(eq (flet ()) nil)
|
|
(eq (flet ( (fun1 () "this is an empty function") ) ) nil)
|
|
(eq (flet ( (fun1 (m n) (declare (integer m)) "m is declared to be an integer"
|
|
(declare (special n)) "n is a special variable" ) ) ) nil)
|
|
)
|
|
)
|
|
|
|
(do-test "test flet - with declare statements / parameter list keywords"
|
|
|
|
(and
|
|
(eq (flet () t) t)
|
|
|
|
(equal (flet ( (let1 () (values 10 20 30 40))
|
|
(let2 () (values "a" "b" "c" "d" "e"))
|
|
(let3 () (values-list '(writing code for flet))) )
|
|
(multiple-value-call #'list (let1) (let2) (let3)) )
|
|
|
|
'(10 20 30 40 "a" "b" "c" "d" "e" writing code for flet) )
|
|
|
|
(equalp (flet ( (fun1 (m n) (declare (integer m n)) (+ m n))
|
|
(fun2 (m n ) (declare (string m n)) (concatenate 'string m n))
|
|
(fun3 (m n o p) (declare (type (integer 2 10) m n o p)) (max m n o p))
|
|
(fun4 (s) (declare (complex s)) (type-of s))
|
|
(fun5 (s r) (declare (number s r)) (vector (gcd s r) (lcm s r))) )
|
|
|
|
(list (fun1 30 29) (fun2 "ac" "e") (fun3 5 7 6 3) (fun4 #c(2 -1)) (fun5 100 23)) )
|
|
|
|
(list 59 "ace" 7 'complex (vector 1 2300)) )
|
|
|
|
(equal (flet ( (fun1 (m n &key o p) (list m n o p))
|
|
(fun2 (m n &optional (o 2 oflag) (p 30 pflag)) (list m n o p oflag pflag))
|
|
(fun3 (m n &rest x &key (y 6) (z 7 zflag)) (list m n x y z zflag)) )
|
|
|
|
(list (fun1 3 4 :p 7 :o 10) (fun2 1 2 3) (fun2 10 20 30 4) (fun3 9 8 :z 11) (fun3 7 6 :y 10) (fun3 3 2)) )
|
|
|
|
'( (3 4 10 7) (1 2 3 30 t nil) (10 20 30 4 t t) (9 8 (:z 11) 6 11 t) (7 6 (:y 10) 10 7 nil) (3 2 nil 6 7 nil)) )
|
|
)
|
|
)
|
|
|
|
|
|
(do-test-group ( "more tests for flet"
|
|
:before (progn
|
|
(test-defun fun1 () 1)
|
|
(test-defun fun2 () 2)
|
|
(test-defun fun3 () 3)
|
|
(test-defun fun4 () 4) ))
|
|
|
|
(do-test "test flet - locally defined functions overshadow the global functions of the same names"
|
|
|
|
(equal (list (fun1) (fun2) (fun3)
|
|
(flet ((fun1 () 10)
|
|
(fun2 () 20)
|
|
(fun3 () 30))
|
|
|
|
(list (fun1) (fun2) (fun3) (fun4)) ) (fun1) (fun2) (fun3) (fun4) )
|
|
|
|
'(1 2 3 ( 10 20 30 4) 1 2 3 4))
|
|
)
|
|
|
|
(do-test "test flet - one can locally redefine a global function and the new definition can refer to the global definition"
|
|
|
|
(equal (flet ((fun1 () (+ (fun1) (fun2) (fun3)))
|
|
(fun2 () (* (fun1) (fun3)))
|
|
(fun3 () (+ (fun2) (fun4))) )
|
|
|
|
(list (fun1) (fun2) (fun3)) )
|
|
|
|
'(6 3 6))
|
|
)
|
|
)
|
|
|
|
(do-test "test flet - make sure those named functions are defined locally"
|
|
|
|
(progn (dolist (x '(fun1 fun2 fun3)) (fmakunbound x))
|
|
(flet ((fun1 () 1) (fun2 () 2) (fun3 () 3))
|
|
(list (fun1) (fun2) (fun3)) )
|
|
(notany #'fboundp '(fun1 fun2 fun3))
|
|
)
|
|
)
|
|
STOP
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|