154 lines
4.3 KiB
Plaintext
154 lines
4.3 KiB
Plaintext
;; Function To Be Tested: unwind-protect
|
|
;;
|
|
;; Source: CLtL Section 7.10: Dynamic Non-local exits Page: 139
|
|
;;
|
|
;; Created By: Karin M. Sye
|
|
;;
|
|
;; Creation Date: Oct. 29 ,1986
|
|
;;
|
|
;; Last Update: Oct. 29 ,1986
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>7-10-unwind-protect.test
|
|
;;
|
|
;;
|
|
;; Syntax: unwind-protect PROTECTED-FORM {CLEANUP-FORM}*
|
|
;;
|
|
;; Function Description: unwind-protect guarantees to execute the cleanup-forms before exiting, whether it terminates normally
|
|
;; or attemps to exit from the protected form. The function returns whatever results from evaluation of the
|
|
;; protected-form and discards all the results from the cleanup-forms.
|
|
;;
|
|
;; Argument(s): PROTECTED-FORM , CLEANUP-FORM - a lisp form
|
|
;;
|
|
;; Returns: anything
|
|
;;
|
|
|
|
(do-test "test unwind-protect returns multiple-vlaues 0"
|
|
|
|
(equal (multiple-value-list (unwind-protect (values 1 2 3 4))) '(1 2 3 4)) )
|
|
|
|
|
|
(do-test "test unwind-protect returns multiple-vlaues 1"
|
|
|
|
(equal (multiple-value-list (unwind-protect (values-list '(a b c d e)) "this is a cleanup form"))
|
|
'(a b c d e)) )
|
|
|
|
(do-test "test unwind-protect guarantees to execute the cleanup-forms before exiting 0"
|
|
|
|
(let (a b c d)
|
|
(and (= (unwind-protect (setq a 10) (setq b 20) (setq c 30) (setq d 40)) 10)
|
|
(equal (list b c d) '(20 30 40))
|
|
)
|
|
)
|
|
)
|
|
|
|
(do-test "test unwind-protect guarantees to execute the cleanup-forms before exiting 1"
|
|
|
|
(let (a b c d)
|
|
(and (= (unwind-protect (prog2 (setq a 10) (setq b 20) (setq b 22)) (setq c 30) (setq d 40)) 20)
|
|
(equal (list a b c d) '(10 22 30 40))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(do-test "test unwind-protect guarantees to execute the cleanup-forms before exiting from catch"
|
|
|
|
(let (a b c d)
|
|
|
|
(equal (list a b c d (catch 'cat (unwind-protect (progn (setq d 9) (throw 'cat (setq c 99)) (setq d 89))
|
|
(setq a "cleanup 1")
|
|
(setq b "cleanup 2") ))
|
|
a b c d)
|
|
'(nil nil nil nil 99 "cleanup 1" "cleanup 2" 99 9))
|
|
)
|
|
)
|
|
|
|
(do-test "test unwind-protect guarantees to execute the cleanup-forms before exiting from block"
|
|
|
|
(let (a b c d)
|
|
|
|
(equal (list a b c d (block blk (unwind-protect (progn (setq d 9) (return-from blk (setq c 99)) (setq d 89))
|
|
(setq a "cleanup 1")
|
|
(setq b "cleanup 2") ))
|
|
a b c d)
|
|
'(nil nil nil nil 99 "cleanup 1" "cleanup 2" 99 9))
|
|
)
|
|
)
|
|
|
|
(do-test "test unwind-protect guarantees to execute the cleanup-forms before exiting from tagbody"
|
|
|
|
(let (a b c d)
|
|
|
|
(equal (list a b c d (tagbody (unwind-protect (progn (setq d 9) (go exit) (setq d 89))
|
|
(setq a "cleanup 1")
|
|
(setq b "cleanup 2") )
|
|
exit (setq c 67))
|
|
a b c d)
|
|
'(nil nil nil nil nil "cleanup 1" "cleanup 2" 67 9))
|
|
)
|
|
)
|
|
|
|
|
|
(do-test "test unwind-protect - the cleanup-forms are not protected by that unwind-protect 0"
|
|
|
|
(let (a b c d)
|
|
|
|
(equal (list a b c d (tagbody (unwind-protect (progn (setq d 9) (setq d 89))
|
|
(setq a "cleanup 1")
|
|
(go exit)
|
|
(setq b "cleanup 2") )
|
|
exit (setq c 67))
|
|
a b c d)
|
|
'(nil nil nil nil nil "cleanup 1" nil 67 89))
|
|
)
|
|
)
|
|
|
|
|
|
(do-test "test unwind-protect - an unwind-protect occurred within the protected form of another unwind-protect 0"
|
|
|
|
(let (a b c d)
|
|
|
|
(equal (list a b c d (tagbody (unwind-protect (tagbody (setq d 9)
|
|
(unwind-protect (setq c 7)
|
|
(go exit)
|
|
(decf c 3)
|
|
(setq d 90))
|
|
done (incf c 2)
|
|
)
|
|
(setq a "cleanup 1")
|
|
(setq c (expt c 2))
|
|
(setq b "cleanup 2") )
|
|
exit (incf c 4))
|
|
a b c d)
|
|
'(nil nil nil nil nil "cleanup 1" "cleanup 2" 53 9))
|
|
)
|
|
)
|
|
|
|
(do-test "test unwind-protect - an unwind-protect occurred within the protected form of another unwind-protect 1"
|
|
|
|
(let (a b c d)
|
|
|
|
(equal (list a b c d (tagbody (unwind-protect (tagbody (setq d 9)
|
|
(unwind-protect (go exit)
|
|
(setq c 7)
|
|
(decf c 3)
|
|
(setq d 90))
|
|
(incf c 2)
|
|
)
|
|
(setq a "cleanup 1")
|
|
(setq c (expt c 2))
|
|
(setq b "cleanup 2") )
|
|
exit (incf c 4))
|
|
a b c d)
|
|
'(nil nil nil nil nil "cleanup 1" "cleanup 2" 20 90))
|
|
)
|
|
)
|
|
STOP
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|