85 lines
2.1 KiB
Plaintext
85 lines
2.1 KiB
Plaintext
;; Function To Be Tested: CONN (Programmer's Assistant Command)
|
|
;;
|
|
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
|
|
;; Section 20.2 (The Evaluator), Page 28
|
|
;; Section: The Evaluator
|
|
;; Page: 9
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Feb 10, 1987
|
|
;;
|
|
;; Last Update: Feb 26, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>test>exec>conn.u
|
|
;;
|
|
;;
|
|
;; Syntax: CONN DIRECTORY
|
|
;;
|
|
;; Function Description: Change default pathname to directory
|
|
;;
|
|
;; Argument(s): DIRECTORY (directory name)
|
|
;;
|
|
;; Returns: connected directory
|
|
;;
|
|
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
|
|
;; testing them will be accomplished using the interlisp comamnd BKSYSBUF in
|
|
;; do-test format. 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". The test result will be automatically logged in the following file:
|
|
;; {eris}<lispcore>test>exec>test.report.
|
|
|
|
|
|
(DO-TEST 'CONN-TEST-SETUP
|
|
(PROGN
|
|
(DEFUN R-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~2%COMMAND:CONN ~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
|
|
(SETQ CONN-COMMAND-STRING
|
|
"(SETQ MESS1 'Connecting-to-new-directory...)
|
|
(SETQ MESS2 'Connecting-to-default-directory...)
|
|
(SETQ MESS3 'Reconnecting-to-default-directory...)
|
|
|
|
(PROGN
|
|
(PRINC MESS2)
|
|
(SLEEP 2)
|
|
(VALUES)
|
|
)
|
|
CONN
|
|
|
|
|
|
(PROGN
|
|
(PRINC MESS1)
|
|
(SLEEP 2)
|
|
(VALUES))
|
|
CONN {CORE}<TEST>
|
|
(SETQ CORE-DIRECTORY *DEFAULT-PATHNAME-DEFAULTS*)
|
|
|
|
(PROGN
|
|
(PRINC MESS3)
|
|
(SLEEP 2)
|
|
(VALUES))
|
|
CONN
|
|
(DO-TEST 'MASTERSCOPE-TEST-RESULT
|
|
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (AND (STRING-EQUAL (PATHNAME-HOST CORE-DIRECTORY) 'CORE)
|
|
(STRING-EQUAL (PATHNAME-DIRECTORY CORE-DIRECTORY) 'TEST))
|
|
(PROGN (R-FORMAT 'SUCCESS) T)
|
|
(PROGN (R-FORMAT 'FAIL) NIL))
|
|
(CLOSE *OUTPUT*)
|
|
)
|
|
)
|
|
")
|
|
(IL:BKSYSBUF CONN-COMMAND-STRING)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|