95 lines
2.7 KiB
Plaintext
95 lines
2.7 KiB
Plaintext
;; Function To Be Tested: FIX (Programmer's Assistant Command)
|
|
;;
|
|
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
|
|
;; Section 20.2 (The Evaluator), Page 28
|
|
;;
|
|
;; Section: The Evaluator
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Feb 11, 1987
|
|
;;
|
|
;; Last Update: Feb 26, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>test>exec>fix.u
|
|
;;
|
|
;; Syntax: FIX &rest EventSpec
|
|
;;
|
|
;; Function Description: Edit the specified event prior to re-executing it
|
|
;;
|
|
;; Argument(s): EventSpec
|
|
;;
|
|
;; Returns: Event to be changed
|
|
;;
|
|
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
|
|
;; testing them willbe accomplished by using the interlisp function bksysbuf
|
|
;; in do-test form. Comments are incorporated within each command file.
|
|
;; The do-test test setup is titled "FIX-TEST-SETUP", which executes the command
|
|
;; string. The do-test form within the command file will return T or "test "quote"
|
|
;; failed in file "unknown". " This test file requires TEDIT package.
|
|
;; The test result will be logged automatically in the following file:
|
|
;; {ERIS}<lispcore>test>exec>test.report
|
|
|
|
(DO-TEST 'FIX-TEST-SETUP
|
|
(PROGN
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
|
|
(DEFUN R-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~%COMMAND: FIX ~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
|
|
(SETQ MESS1 "Fixing the previous events...")
|
|
(SETQ MESS2 "The new values should now be different from the previous ones...")
|
|
(SETQ MESS3 "Testing has succeeded; the old events were fixed and their new values are now different from the old ones")
|
|
(SETQ FORMAT-STRING "POP-ELEMENT-1: ~A POP-ELEMENT-2: ~A ~% TODAY-1: ~D TODAY-2: ~D ~% RUNTIME-1: ~D RUNTIME-2: ~D")
|
|
(SETQ FIX-STRING
|
|
"FIX -8
|
|
FIX -7
|
|
FIX -6
|
|
(SETQ POP-ELEMENT-2 CL:*** TODAY-2 CL:** RUNTIME-2 CL:*)
|
|
DA
|
|
|
|
(PROGN
|
|
(PRINC MESS2)
|
|
(SLEEP 2)
|
|
(VALUES)
|
|
(FORMAT NIL FORMAT-STRING POP-ELEMENT-1 POP-ELEMENT-2 TODAY-1 TODAY-2
|
|
RUNTIME-1 RUNTIME-2)
|
|
)
|
|
(SLEEP 2)
|
|
|
|
(DO-TEST 'FIX-TEST-RESULT
|
|
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (AND (NOT (EQ POP-ELEMENT-1 POP-ELEMENT-2))
|
|
(NOT (= TODAY-1 TODAY-2))
|
|
(NOT (= RUNTIME-1 RUNTIME-2)))
|
|
(PROGN (R-FORMAT 'SUCCESS) T)
|
|
(PROGN (R-FORMAT 'FAIL) NIL))
|
|
(CLOSE *OUTPUT*)
|
|
)
|
|
)
|
|
")
|
|
|
|
(SETQ FIX-COMMAND-STRING
|
|
"(SETQ STACK '(A B C))
|
|
(POP STACK)
|
|
(SETQ POP-ELEMENT-1 IL:IT)
|
|
(SETQ TODAY (GET-UNIVERSAL-TIME))
|
|
(SETQ TODAY-1 IL:IT)
|
|
(SETQ RUNTIME (GET-INTERNAL-RUN-TIME))
|
|
(SETQ RUNTIME-1 IL:IT)
|
|
(PROGN (PRINC MESS1)
|
|
(SLEEP 2)
|
|
(VALUES)
|
|
)
|
|
|
|
(IL:EVAL.AS.PROCESS '(IL:BKSYSBUF FIX-STRING))
|
|
")
|
|
(IL:BKSYSBUF FIX-COMMAND-STRING)
|
|
|
|
)
|
|
)
|
|
STOP
|
|
|
|
|
|
|
|
|