;; 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