1
0
mirror of synced 2026-01-22 19:00:53 +00:00

73 lines
2.3 KiB
Plaintext

;; Function To Be Tested: DO-EVENTS (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>integration>exec>do-events.u
;;
;;
;; Syntax: DO-EVENTS &rest INPUTS &Environment ENV
;;
;; Function Description: Executes the multiple events in INPUTS, using ENV for
;; non-EVAL format
;;
;; Argument(s): INPUTS and ENV
;;
;; Returns: Results of the multiple events in INPUTS
;;
;; 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 "DO-EVENTS-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 'DO-EVENTS-TEST-SETUP
(PROGN
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
(DEFUN R-FORMAT (STATUS)
(FORMAT *OUTPUT* "~%COMMAND: DO-EVENTS ~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
(SETQ MESS0 "This constitutes partial testing only...")
(SETQ MESS1 "The values should now have been assigned to first-event, second-event, and third event are as follows...")
(SETQ FORMAT-STRING "FIRST-EVENT: ~D ~% SECOND-EVENT: ~D ~% THIRD-EVENT: ~D")
(SETQ DO-EVENTS-STRING
"(PROGN
(PRINC MESS0)
(SLEEP 2)
(VALUES)
)
DO-EVENTS (SETQ FIRST-EVENT 10) (SETQ SECOND-EVENT 20) (SETQ THIRD-EVENT 30)
(PROGN
(PRINC MESS1)
(SLEEP 2)
(VALUES)
(FORMAT NIL FORMAT-STRING FIRST-EVENT SECOND-EVENT THIRD-EVENT )
)
(DO-TEST 'DO-EVENTS-TEST-RESULT
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
:IF-EXISTS :APPEND))
(IF (AND (= FIRST-EVENT 10)
(= SECOND-EVENT 20)
(= THIRD-EVENT 30))
(PROGN (R-FORMAT 'SUCCESS) T)
(PROGN (R-FORMAT 'FAIL) NIL))
(CLOSE *OUTPUT*)
)
)
")
(IL:BKSYSBUF DO-EVENTS-STRING)
)
)
STOP