97 lines
3.0 KiB
Plaintext
97 lines
3.0 KiB
Plaintext
;; Function To Be Tested: RETRY (Programmer's Assistant Command)
|
|
;;
|
|
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
|
|
;; CLtL, Section 20.2 (The Evaluator)
|
|
;; Section: The RETRY
|
|
;; Page: 28
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Feb 23, 1987
|
|
;;
|
|
;; Last Update: March 24, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>test>exec>retry.u
|
|
;;
|
|
;;
|
|
;; Syntax: RETRY EVENT-SPEC
|
|
;;
|
|
;; Function Description: Similar to REDO except sets the debugger parameters
|
|
;; so that any errrors that occur while executing EventSpec will cause breaks.
|
|
;;
|
|
;; Argument(s): Event-Spec
|
|
;;
|
|
;; Returns: See function description
|
|
;;
|
|
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
|
|
;; testing them will not be totally automatic. Comments are incorporated within
|
|
;; each command file, which will be run by using the function bksysbuf.
|
|
;; Each test setup is titled "COMMAND-TEST-SETUP", which executes the command
|
|
;; string. The do-test form within the command file will return T or "test
|
|
;; failed" This test file requires TEDIT package. Since RETRY will break on error,
|
|
;; it should be tested manually to see if a break window appear.
|
|
;;
|
|
;; Messages will be printed before each command in the command files is executed
|
|
;; for user monitoring. Test result is logged on
|
|
;; {eris}<lispcore>test>exec>test.report.
|
|
|
|
(DO-TEST "RETRY-TEST-SETUP"
|
|
(PROGN
|
|
(SETQ MESS0 "Setting variables X,Y, and Z to some numbers...")
|
|
(SETQ MESS1 "Re-executing the previous event...")
|
|
(SETQ MESS2 "Please enter (RETRY-Z) after do-test is completed
|
|
determine if RETRYing an event that generates an error will break...
|
|
The apperance of a break window is the expected result.
|
|
After entering ^ in the break window, indicate whether
|
|
test has succeeded or failed by entering (RETRY-TEST T)
|
|
or (RETRY-TEST NIL) respectively")
|
|
(DEFUN RETRY-Z NIL (IL:BKSYSBUF "RETRY-Z
|
|
RETRY
|
|
"))
|
|
(DEFUN RETRY-TEST (FLG)
|
|
(PROGN
|
|
(SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (EQ FLG T)
|
|
(R-FORMAT 'SUCCESS)
|
|
(R-FORMAT 'FAIL))
|
|
(CLOSE *OUTPUT*)))
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
|
|
(DEFUN R-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~%COMMAND: RETRY-BREAK~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
|
|
|
|
(DEFUN R1-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~%COMMAND: RETRY~%STATUS: ~A DATE: ~A TESTER: ~A~%Comment: Tester should enter (RETRY-Z) to see if a break window ~%does appear on error.~%" STATUS (IL:DATE) IL:USERNAME))
|
|
|
|
(SETQ RETRY-COMMAND-STRING
|
|
"(FORMAT NIL MESS0)
|
|
(SETQ X 100 Y 50)
|
|
(SETQ Z (+ X Y))
|
|
(FORMAT NIL MESS1)
|
|
RETRY -2
|
|
(SETQ NEW-Z CL:*)
|
|
(SETQ Y 'NON-NUMBER)
|
|
(SETQ Z (+ X Y))
|
|
NAME RETRY-Z -1
|
|
(IL:PROMPTPRINT MESS2)
|
|
(SLEEP 3)
|
|
(DO-TEST 'RETRY-TEST-RESULT
|
|
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (= Z NEW-Z)
|
|
(PROGN (R1-FORMAT 'SUCCESS) T)
|
|
(PROGN (R1-FORMAT 'FAIL) NIL))
|
|
(CLOSE *OUTPUT*)
|
|
)
|
|
)
|
|
")
|
|
(IL:BKSYSBUF RETRY-COMMAND-STRING)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|