115 lines
3.2 KiB
Plaintext
115 lines
3.2 KiB
Plaintext
;; Function To Be Tested: PL (Programmer's Assistant Command)
|
|
;;
|
|
;; Function To Be Tested: USE (multiple) (EXEC 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 12, 1987
|
|
;;
|
|
;; Last Update: Feb 27, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>test>exec>pl.u
|
|
;;
|
|
;;
|
|
;; Syntax: PL SYMBOL
|
|
;;
|
|
;; Function Description: Prints the property list of SYMBOL in an easy to read format.
|
|
;;
|
|
;; Argument(s): SYMBOL
|
|
;;
|
|
;; Returns: See function description
|
|
;;
|
|
;; 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 "PL-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 'PL-TEST-SETUP
|
|
(PROGN
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
|
|
(DEFUN R-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~%COMMAND: PL ~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
|
|
|
|
(SETQ MESS0 "Creating property values for THOMAS...")
|
|
(SETQ MESS1 "The following will print the property list for THOMAS...")
|
|
(SETQ MESS2 "Removing all property values for THOMAS...")
|
|
(SETQ MESS3 "As observed, there is no property value for THOMAS.")
|
|
(SETQ {CORE}PL-1 "{CORE}PL-1")
|
|
(SETQ PL-COMMAND-STRING
|
|
"(PROGN
|
|
(PRINC MESS0)
|
|
(SLEEP 1)
|
|
(VALUES)
|
|
)
|
|
(SETF (GET 'THOMAS 'AGE) 28
|
|
(GET 'THOMAS 'BIRTHDATE) 'Jan-8-59
|
|
(GET 'THOMAS 'HOBBY) 'SKIING
|
|
(GET 'THOMAS 'JOB) 'ARTIST
|
|
(GET 'THOMAS 'HOME) 'LONDON
|
|
)
|
|
(PROGN
|
|
(PRINC MESS1)
|
|
(SLEEP 1)
|
|
(VALUES)
|
|
)
|
|
(DRIBBLE '{CORE}PL-1)
|
|
PL THOMAS
|
|
(DRIBBLE)
|
|
(PROGN
|
|
(PRINC MESS2)
|
|
(SLEEP 1)
|
|
(VALUES)
|
|
)
|
|
(SETF (SYMBOL-PLIST 'THOMAS) NIL)
|
|
PL THOMAS
|
|
(IF (EQ * NIL) (SETQ NO-PROP-FLG T) (SETQ NO-PROP-FLG NIL))
|
|
(PROGN
|
|
(PRINC MESS3)
|
|
(SLEEP 1)
|
|
(VALUES)
|
|
)
|
|
|
|
; The follow is an analysis of files containing the property list before and after
|
|
; the property was assigned and removed from THOMAS:
|
|
(SETQ PROPERTY-LIST '(|age : 28| |birthdate : jan-8-59| |hobby : skiing|
|
|
|job : artist| |home : london|))
|
|
(SETQ PROP-FLG NIL)
|
|
(LET ((PL-1 (OPEN {CORE}PL-1)))
|
|
(DO ((j 0 (1+ j)))
|
|
((= j 3) t) (READ-LINE PL-1))
|
|
(PROGN (DOLIST (Y PROPERTY-LIST)
|
|
(IF (STRING-EQUAL Y (READ-LINE PL-1))
|
|
(PUSH T PROP-FLG ) (PUSH NIL PROP-FLG))
|
|
)
|
|
(CLOSE PL-1)
|
|
)
|
|
)
|
|
|
|
; Now do-test will determine if the property list for THOMAS has ever existed
|
|
; if it has been removed
|
|
|
|
(DO-TEST 'MULTIPLE-USE-TEST-RESULT
|
|
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (AND (NOTANY #'NULL PROP-FLG)
|
|
(EQ NO-PROP-FLG T))
|
|
(PROGN (R-FORMAT 'SUCCESS) T)
|
|
(PROGN (R-FORMAT 'FAIL) NIL))
|
|
(CLOSE *OUTPUT*)
|
|
)
|
|
)
|
|
")
|
|
(IL:BKSYSBUF PL-COMMAND-STRING)
|
|
)
|
|
)
|
|
STOP
|