;; Function To Be Tested: FORGET (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 25, 1987 ;; ;; Last Update: ;; ;; Filed As: {ERIS}test>exec>forget.u ;; ;; ;; Syntax: FORGET &rest EVENT-SPEC ;; ;; Function Description: Erase UNDO information for the specified events. ;; ;; 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. ;; ;; ;; Messages will be printed before each command in the command files is executed ;; for user monitoring. Test result is logged on ;; {eris}test>exec>test.report. (DO-TEST "FORGET-TEST-SETUP" (PROGN (SETQ MESS1 "Now do-test will determine if side effects of the forgotten event cannot be undone...") (SETQ TEST-RESULT "{ERIS}TEST>EXEC>TEST.REPORT") (DEFUN R-FORMAT (STATUS) (FORMAT *OUTPUT* "~%COMMAND: FORGET~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME)) (SETQ FORGET-COMMAND-STRING "; Unbound all undo variables (MAPCAR #'MAKUNBOUND '(FORGET-VAR-1 FORGET-VAR-2)) ; CASE I Setting and resetting the variable FORGET-VAR-1.. (SETQ FORGET-VAR-1 100) (SETQ FORGET-VAR-1 200) ; The following will UNDO the side effect of (SETQ FORGET-VAR-1 200) UNDO -1 ; SETQ in undone and nothing should have been saved now (IF (= FORGET-VAR-1 100) (SETQ VAR-PROP-1 'UNDONE) (SETQ VAR-PROP-1 'INTACT)) ; CASE II (FORGET) Setting and reseeting the variable FORGET-VAR-2... (SETQ FORGET-VAR-2 700) (SETQ FORGET-VAR-2 800) ; Erasing undo information on (SETQ FORGET-VAR-2 800) FORGET -1 ; The event (SETQ FORGET-VAR-2 800) has been erased from history list ; Setq cannot be undone UNDO -2 (IF (= FORGET-VAR-2 800) (SETQ VAR-PROP-2 'FORGOTTEN) (SETQ VAR-PROP-2 'UNFORGOTTEN)) (FORMAT NIL MESS1) (DO-TEST 'FORGET-TEST-RESULT (PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT :IF-EXISTS :APPEND)) (IF (AND (EQ VAR-PROP-1 'UNDONE) (EQ VAR-PROP-2 'FORGOTTEN)) (PROGN (R-FORMAT 'SUCCESS) T) (PROGN (R-FORMAT 'FAIL) NIL)) (CLOSE *OUTPUT*) ) ) ") (IL:BKSYSBUF FORGET-COMMAND-STRING) ) ) STOP