90 lines
2.4 KiB
Plaintext
90 lines
2.4 KiB
Plaintext
;; Function To Be Tested: untrace
|
|
;;
|
|
;; Source: Guy L Steele's CLTL Chapter 25:Miscellaneous Features
|
|
;; Section: 25.3 Debugging Tools
|
|
;; Page: 440
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Aug 28,1986
|
|
;;
|
|
;; Last Update: Oct 3, 1986
|
|
;;
|
|
;; Filed As: {ERIS}<LISPCORE>CML>TEST>25-3-untrace.test
|
|
;;
|
|
;;
|
|
;; Syntax: (untrace {function-name}*)
|
|
;;
|
|
;; Function Description: Invoking untrace with one or more function names (symbols)
|
|
;; causes those functions not to be traced any more. Calling untrace with no
|
|
;; argument forms will cause all currently traced functions to be no longer
|
|
;; traced.
|
|
;;
|
|
;; Argument(s): function name(s)
|
|
;;
|
|
;; Returns: list of function(s) being untraced.
|
|
;;
|
|
;; Constraints/Limitations: This test is divided into two parts: testing xerox
|
|
;; implementation of untrace and other implementations of trace. Since this
|
|
;; function requires user-interface, it's not realistic to run this test
|
|
;; automatically. For the Xerox implementation, the test is conducted to determine
|
|
;; if the functions being untraced are returned without opening or closing the
|
|
;; tracewindow. On other implementations, this merely tests to see if there is
|
|
;; a global function definition for untrace, which does not necessarily mean
|
|
;; it has met the requirements prescribed in CLtL. For complete certification,
|
|
;; manual testing is required.
|
|
|
|
|
|
(do-test-group ("untrace-test-setup"
|
|
:before (progn
|
|
(defun factorial (n)
|
|
(cond ((zerop n) 1)
|
|
(t (* n (factorial (1- n))))))
|
|
|
|
(defun fibonacci (n)
|
|
(cond ((= n 0) 1)
|
|
((= n 1) 1)
|
|
(t (+ (fibonacci (- n 1))
|
|
(fibonacci (- n 2))))))
|
|
|
|
(defun squash (s)
|
|
(cond ((null s) nil)
|
|
((atom s) (list s))
|
|
(t (append (squash (car s))
|
|
(squash (cdr s))))))
|
|
|
|
|
|
(defun untrace-test (implementation-type)
|
|
(cond ((string-equal implementation-type "XEROX")
|
|
(untrace-test-xerox))
|
|
(t (untrace-test-others))))
|
|
|
|
|
|
(defun untrace-test-xerox ()
|
|
(and (boundp 'tracewindow)
|
|
(trace factorial)
|
|
(equal (untrace factorial) '(factorial))
|
|
(trace fibonacci squash)
|
|
(equal (untrace squash) '(squash))
|
|
(trace factorial)
|
|
(not (set-difference
|
|
(untrace) '(factorial fibonacci)))
|
|
(eq (untrace) nil)))
|
|
|
|
(defun untrace-test-others ()
|
|
(fboundp 'untrace))
|
|
)
|
|
)
|
|
|
|
(do-test "untrace-test"
|
|
(untrace-test (lisp-implementation-type))))
|
|
|
|
|
|
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|