159 lines
5.6 KiB
Plaintext
159 lines
5.6 KiB
Plaintext
;; Function To Be Tested: PP (Programmer's Assistant Command)
|
|
;;
|
|
;; Source: Xerox Common Lisp Implementation Notes (Lyric Beta Release)
|
|
;; CLtL, Section 20.2
|
|
;; Section: The Evaluator
|
|
;; Page: 29
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Feb 17, 1987
|
|
;;
|
|
;; Last Update: Mar 23, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>integration>exec>pp.u
|
|
;;
|
|
;;
|
|
;; Syntax: PP &optional NAME &rest TYPES
|
|
;;
|
|
;; Function Description: Show (prettyprinted) the definitions for NAME specified by
|
|
;; TYPES
|
|
;;
|
|
;; Argument(s): NAME (object) & TYPES (function, macro, vars, etc)
|
|
;;
|
|
;; Returns: See function description
|
|
;;
|
|
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
|
|
;; testing them will be 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 "TY-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
|
|
;; Messages will be printed before each command in the command files is executed for
|
|
;; user monitoring. This test will pp an object to a stream, which is opened for
|
|
;; user review. Keyword (object name) should be in bold and pretty printed
|
|
;; definitions should be formatted for readability. This test determines whether
|
|
;; Keyword(s) are in bold and function/macro definitions are structured.
|
|
|
|
(DO-TEST 'PP-TEST-SETUP
|
|
(PROGN
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>EXEC>TEST.REPORT")
|
|
(DEFUN R-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~%COMMAND: PP ~%STATUS: ~A DATE: ~A TESTER: ~A~%" STATUS (IL:DATE) IL:USERNAME))
|
|
(SETQ MESS0 "Defining a function called message .....")
|
|
(SETQ MESS1 "Pretty printing the function definition for message...")
|
|
(SETQ MESS2 "Creating a stream to output a pretty printed function defintion...")
|
|
(SETQ MESS2.5 "The keyword message should be in bold and the function should be printed with indentation...")
|
|
|
|
(SETQ MESS3 "Saving the pretty-printed function definition in a file...")
|
|
(SETQ MESS4 "Setting message to some value.....")
|
|
(SETQ MESS5 "Pretty printing the variable definition for message...")
|
|
(SETQ MESS6 "Creating a stream to output a pretty printed variable defintion...")
|
|
(SETQ MESS6.5 "The keyword message should be in bold...")
|
|
(SETQ MESS7 "Saving the pretty-printed varible definition in a file...")
|
|
(SETQ DO-LIST-CONTENTS-F
|
|
'("(defun message (mess) (progn (princ mess)"
|
|
"(sleep 1)"
|
|
"(values)))"))
|
|
(SETQ VARIABLE-STRING "(il:rpaqq message this-is-a-variable)")
|
|
(SETQ PP-COMMAND-STRING
|
|
";; Test to see if the function message is pretty-printed
|
|
(MESSAGE MESS0)
|
|
(DEFUN MESSAGE (MESS) (PROGN (PRINC MESS)(SLEEP 1)(VALUES)))
|
|
(MESSAGE MESS1)
|
|
PP MESSAGE FUNCTION
|
|
(MESSAGE MESS2)
|
|
(SETQ PP-WINDOW-F (IL:CREATEW '(100 100 400 200)
|
|
'PP-WINDOW-FOR-TESTING))
|
|
(SETQ *STANDARD-OUTPUT1* *STANDARD-OUTPUT*) ; Save the original pointer
|
|
(SETQ PP-STREAM-F (IL:OPENTEXTSTREAM NIL PP-WINDOW-F))
|
|
(SETQ *STANDARD-OUTPUT* PP-STREAM-F)
|
|
PP MESSAGE FUNCTION
|
|
(SETQ *STANDARD-OUTPUT* *STANDARD-OUTPUT1*) ; Change it back to original pointer
|
|
(MESSAGE MESS2.5)
|
|
(SETQ SELECTION-F (IL:TEDIT.SETSEL PP-STREAM-F 8 7))
|
|
(SETQ PLIST-F (IL:TEDIT.GET.LOOKS PP-STREAM-F SELECTION-F))
|
|
(SETQ KEYWORD-F
|
|
(CADR (MULTIPLE-VALUE-LIST (GET-PROPERTIES PLIST-F '(IL:WEIGHT)))))
|
|
;; Should return IL:BOLD
|
|
(SETQ SELECTION-F1 (IL:TEDIT.SETSEL PP-STREAM-F 16 27))
|
|
(SETQ PLIST-F1 (IL:TEDIT.GET.LOOKS PP-STREAM-F SELECTION-F1))
|
|
(SETQ NONKEYWORD-F
|
|
(CADR (MULTIPLE-VALUE-LIST (GET-PROPERTIES PLIST-F1 '(IL:WEIGHT)))))
|
|
;; Should return IL:MEDIUM
|
|
(MESSAGE MESS3)
|
|
(IL:TEDIT.PUT PP-WINDOW-F '{CORE}PPF)
|
|
(CLOSE PP-STREAM-F)
|
|
(IL:CLOSEW PP-WINDOW-F)
|
|
|
|
;; Test to see if the variable message is pretty-printed
|
|
(MESSAGE MESS4)
|
|
(SETQ MESSAGE 'THIS-IS-A-VARIABLE)
|
|
(MESSAGE MESS5)
|
|
PP MESSAGE VARS
|
|
(MESSAGE MESS6)
|
|
(SETQ PP-WINDOW-V (IL:CREATEW '(100 100 400 200)
|
|
'PP-WINDOW-FOR-TESTING))
|
|
(SETQ *STANDARD-OUTPUT1* *STANDARD-OUTPUT*)
|
|
(SETQ PP-STREAM-V (IL:OPENTEXTSTREAM NIL PP-WINDOW-V))
|
|
(SETQ *STANDARD-OUTPUT* PP-STREAM-V)
|
|
PP MESSAGE VARS
|
|
(SETQ *STANDARD-OUTPUT* *STANDARD-OUTPUT1*)
|
|
(SETQ SELECTION-V (IL:TEDIT.SETSEL PP-STREAM-V 12 7))
|
|
(SETQ PLIST-V (IL:TEDIT.GET.LOOKS PP-STREAM-V SELECTION-V))
|
|
(MESSAGE MESS6.5)
|
|
(SETQ KEYWORD-V
|
|
(CADR (MULTIPLE-VALUE-LIST (GET-PROPERTIES PLIST-V '(IL:WEIGHT)))))
|
|
;; Should return IL:BOLD
|
|
|
|
(SETQ SELECTION-V1 (IL:TEDIT.SETSEL PP-STREAM-V 20 4))
|
|
(SETQ PLIST-V1 (IL:TEDIT.GET.LOOKS PP-STREAM-V SELECTION-V1))
|
|
(SETQ NONKEYWORD-V
|
|
(CADR (MULTIPLE-VALUE-LIST (GET-PROPERTIES PLIST-V1 '(IL:WEIGHT)))))
|
|
;; Should return IL:MEDIUM
|
|
(MESSAGE MESS7)
|
|
(IL:TEDIT.PUT PP-WINDOW-V '{CORE}PPV)
|
|
(CLOSE PP-STREAM-V)
|
|
(IL:CLOSEW PP-WINDOW-V)
|
|
(SETQ PPF-FLG NIL)
|
|
(SETQ STREAM-F (OPEN '{CORE}PPF))
|
|
(SETQ STREAM-V (OPEN '{CORE}PPV))
|
|
(DOLIST (Y DO-LIST-CONTENTS-F)
|
|
(IF (STRING-EQUAL Y (READ-LINE STREAM-F))
|
|
(PUSH T PPF-FLG)
|
|
(PUSH NIL PPF-FLG)
|
|
)
|
|
)
|
|
(READ-LINE STREAM-V)
|
|
(IF (STRING-EQUAL (READ-LINE STREAM-V) VARIABLE-STRING )
|
|
(SETQ PPV-FLG T)
|
|
(SETQ PPV-FLG NIL)
|
|
)
|
|
(MAPCAR #'CLOSE (IL:OPENP))
|
|
(MAPCAR #'DELETE-FILE (IL:DIRECTORY '{CORE}))
|
|
(DO-TEST 'SEE-WITHOUT-COMMENT-TEST-RESULT
|
|
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (AND (NOT (EQ KEYWORD-F NONKEYWORD-F))
|
|
(NOT (EQ KEYWORD-V NONKEYWORD-V))
|
|
(NOTANY #'NULL PPF-FLG)
|
|
(EQ PPV-FLG T))
|
|
(PROGN (R-FORMAT 'SUCCESS) T)
|
|
(PROGN (R-FORMAT 'FAIL) NIL))
|
|
(CLOSE *OUTPUT*)
|
|
)
|
|
)
|
|
|
|
")
|
|
(IL:BKSYSBUF PP-COMMAND-STRING)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|