104 lines
2.7 KiB
Plaintext
104 lines
2.7 KiB
Plaintext
;; Function To Be Tested: progv
|
|
;;
|
|
;; Source: CLtL Section 7.5: Establishing New Variable Bindings Page: 112
|
|
;;
|
|
;; Created By: Karin M. Sye
|
|
;;
|
|
;; Creation Date: Oct. 27 ,1986
|
|
;;
|
|
;; Last Update: Oct. 27 ,1986
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>7-5-progv.test
|
|
;;
|
|
;;
|
|
;; Syntax: progv SYMBOLS VALUES {FORM}*
|
|
;;
|
|
;; Function Description: progv allows binding one or more dynamic variables whose names may be determined at run time.
|
|
;; The sequences of forms (an implicit progn) is evaluated with the dynamic variables whose names are
|
|
;; in the list SYMBOLS bound to corresponding values from the list VALUES. The results of the progv form
|
|
;; are those of the last form.
|
|
;;
|
|
;; Argument(s): SYMBOLS - a form which returns a list of symbols after being computed
|
|
;; VALUES - a form which returns a list of values after being computed
|
|
;; FORM -
|
|
;;
|
|
;; Returns: anything
|
|
;;
|
|
|
|
|
|
(do-test "test progv - the body of progv is an implicit progn"
|
|
|
|
(and (not (progv '() '()))
|
|
|
|
(progv '(a b) '(#\a #\b) (every #'characterp (list a b)))
|
|
|
|
(equal (multiple-value-list (progv '(aa bb cc) (list 1 -1 2) (values aa bb cc))) '(1 -1 2))
|
|
)
|
|
)
|
|
|
|
(do-test "test progv - if too many values are supplied, the excess values are ignored"
|
|
|
|
(and (equal (progv (list 'a 'b 'c 'd) (list 11 22 33 44 55) (list d b c a)) '(44 22 33 11))
|
|
|
|
(equal (progv '(x y) '(1 2 3 4 5 6) (list x y)) '(1 2))
|
|
)
|
|
)
|
|
|
|
|
|
(do-test "test progv - if too few values are supplied, the remaining symbols are bound and then made to have no value"
|
|
|
|
(and
|
|
(progv '(a b c d) '(10 20)
|
|
(and (equal (list a b) '(10 20))
|
|
(notany #'boundp '(c d))
|
|
)
|
|
)
|
|
(progv '(aa bb cc dd ee ff gg) '()
|
|
(notany #'boundp '(aa bb cc dd ee ff gg))
|
|
)
|
|
)
|
|
)
|
|
|
|
(do-test-group ("test progv - progv allows bindings for dynamic variables"
|
|
|
|
:before (progn (test-defun pro1 () (declare (special w x y z))
|
|
(set 'w (concatenate 'string w "ce"))
|
|
(cons (pro2) w))
|
|
|
|
(test-defun pro2 () (declare (special w x y z))
|
|
(set 'y (concatenate 'string y "ell"))
|
|
(list x y z))
|
|
))
|
|
|
|
(do-test "test progv - progv allows bindings for dynamic variables"
|
|
|
|
(and
|
|
(progv '(m n o p) '(9 8 7 6)
|
|
(set 'm 99)
|
|
(set 'o 70)
|
|
(equal (list m n o p) '(99 8 70 6))
|
|
)
|
|
(progv '(w x y z) '("a" "b" "c" "d")
|
|
(equal (pro1) '(("b" "cell" "d") . "ace"))
|
|
)
|
|
(let ((w 10) (x 20) (y 30) (z 40))
|
|
(declare (special w x y z))
|
|
(and (progv '(w x y z) '("a" "b" "c" "d")
|
|
(equal (pro1) '(("b" "cell" "d") . "ace"))
|
|
)
|
|
;;
|
|
;; the bindings of the dynamic variables are undone on exit from the progv form
|
|
;;
|
|
(equal (list w x y z) '(10 20 30 40))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
STOP
|
|
|
|
|
|
|
|
|
|
|
|
|