89 lines
2.7 KiB
Plaintext
89 lines
2.7 KiB
Plaintext
;; Function To Be Tested: trace
|
|
;;
|
|
;; 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-trace.test
|
|
;;
|
|
;;
|
|
;; Syntax: (trace {function-name}*)
|
|
;;
|
|
;; Function Description: Invoking trace with one or more function names (symbols)
|
|
;; causes the functions named to be traced. Henceforth, whenever such a function
|
|
;; is invoked, information about the call, the arguments passed, and the eventually
|
|
;; returned values, if any, will be printed to the stream that is the value of
|
|
;; *trace-output*. Tracing an already traced function, not currently being traced,
|
|
;; should produce no harmful effects, but may produce a warning message. Calling
|
|
;; trace with no argument forms will return a list of functions currently being
|
|
;; traced.
|
|
;;
|
|
;; Argument(s): function name(s)
|
|
;;
|
|
;; Returns: list of function(s) being traced.
|
|
;;
|
|
;; Constraints/Limitations: This test is divided into two parts: testing xerox
|
|
;; implementation of trace 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 traced are returned without opening or closing the tracewindow. On other
|
|
;; implementations, this merely tests to see if there is a global function
|
|
;; definition for trace, which does not necessarily mean it has met the requirements
|
|
;; prescribed in CLtL. For complete certification, manual testing is required.
|
|
|
|
|
|
|
|
(do-test-group ("trace-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 trace-test (implementation-type)
|
|
(cond ((string-equal implementation-type "XEROX")
|
|
(trace-test-xerox))
|
|
(t (trace-test-others))))
|
|
|
|
|
|
(defun trace-test-xerox ()
|
|
|
|
(and (boundp 'tracewindow)
|
|
(equal (trace factorial) '(factorial))
|
|
(untrace)
|
|
(equal (trace fibonacci squash)
|
|
'(fibonacci squash))
|
|
(untrace squash)
|
|
(equal (trace) '(fibonacci))
|
|
(untrace)
|
|
(eq (trace) nil)
|
|
(untrace)))
|
|
|
|
(defun trace-test-others ()
|
|
(fboundp 'trace))
|
|
)
|
|
)
|
|
|
|
(do-test "trace-test"
|
|
(trace-test (lisp-implementation-type))))
|
|
|
|
|
|
STOP
|