Interlisp.medley/internal/test/env/program-analysis/hand/INSPECT.U

;; Function To Be Tested: INSPECTOR (Program Analysis)
;;
;; Source: IRM VOLUME 3 (Lyric Beta Release 2)
;;		 Section 26. User Input/Output Packages
;; Section: Program Analysis 
;;
;; Created By:   John Park
;;
;; Creation Date: March 21, 1987
;;
;; Last Update:  March 30, 1987
;;
;; Somewhat Repaired:	June 16, 1988
;;
;; Filed As:      {ERIS}<lispcore>test>program-analysis>inspector.u
;;
;;
;; Syntax:  (INSPECT OBJECT ASTYPE WHERE) - primary inspector function    
;;
;; Function Description: The inspector provides a display-oriented and window-based
;; facility for looking at and changing arbitrary Interlisp-D data structures. 
;; The inspector can be used to inspect all ser datatypes and many sysem datatypes. 
;; The inspector displays the field names and values of an arbitrary object in 
;; a window that allows setting of the properties and further inpection of the values.
;; This latter feature makes it possible to "walk" around all of the data structures
;; in the system at the touch of a buttton.  For more information, refer to IRM, vol 2
;; pages 26.1 through 26.9
;; 
;; Argument(s):  The primary function for inspector is INSPECT whose arguments are
;; described here. 
;; OBJECT: object to be inspected
;; ASTYPE: Record type of OBJECT.  If ASTYPE is NIL, the data type of OJECT will be 
;; 		used to determine its property names in the inspect window.
;; WHERE: speccifies the location of the inspect window.  If NIL, the user will be
;; prompted for location 
;;			  
;; Returns:  Inspection Window   
;;
;; Constraints/Limitations: The primary emphasis of this testing will be focused 
;; on the function INSPECT.  Instructions will be given in the prompt
;; window for the user action to be taken during testing and appropriate messages
;; will be displayed to explain each test process. Test result is logged on 
;; {eris}<lispcore>test>program-analysis>inspect.report.  This test requires
;; TEDIT package. 
;;
;;
;;
(DO-TEST "INSPECTOR-TEST-SETUP"

		(SETQ TEST-SUCCEEDED T)

(DEFUN PASS-FAIL (COMMAND-LANGUAGE TEST-ITEM)
	(IL:IF (NOT TEST-ITEM) 
		IL:THEN (FORMAT *ERROR-OUTPUT* "Test ~s failed~%" COMMAND-LANGUAGE)
			   (SETQ TEST-SUCCEEDED NIL)
		IL:ELSE "Woo! It worked!"
		))

	(SETQ INSPECTORW (IL:CREATEW '(100 100 325 90) "TEST WINDOW FOR INSPECTION" NIL T))
	(SETQ INSPECTOR "INSPECTOR")
	(SETQ INSPECTCODE-TITLE "CODE FOR COS")

; Creating various objects to be inspected....
	(SETQ INSPECT-ITEM-LIST
		(LIST		(make-array '(3 3) :displaced-to (make-array '(4 3))) ; array
				(gentemp)			; atom
				(1- most-negative-fixnum) ; bignum
				0				; bit
				'#*1001			; bit-vector
				#\backspace		; character
				'common			; common
				#'cons			; compiled-function
				#c( 6/7 3.00)		; complex
				'( a b c . d)		; cons
				5.00				; double-float
				(random most-positive-fixnum) ; fixnum
				(coerce most-negative-fixnum 'float) ; float
				#'(lambda nil nil)	; function
				(setq hash
				(make-hash-table 7))	; hash-table
				4761				; integer
				:mot-de-clef		; keyword
				'(a b c d)			; list
				37e5				; long-float
				(= 1 2)			; null
				3.1415926535897932384d0 ; number
				(car(list-all-packages))	; package
				(pathname)			; pathname
				;*random-state*		; random state - inspecting this hangs				
				27/60				; ratio
				5				; rational
				(copy-readtable)	; readtable
				'(A 'B "C")		; sequence
;; Breaks; see AR 6494
				(coerce 6 'short-float) ; short-float
				(make-array '(2 2))	; simple-array
				'#*1001			; simple-bit-vector
				"twine"			; simple-string
				(make-array 50 :initial-element 0) ; simple-vector
				.001				; single-float
				#\*				; standard-char
				(make-synonym-stream) ; stream
				(make-array 20 :element-type 'string-char :initial-element #\0) ; string
				#\.				; string-char
				(gentemp)			; symbol
				(not (equal 2 3))	; t
				'#( 5 4 3 2 1)		; vector
				IL:promptwindow		; window
			))
	(SETF (GETHASH 'COLOR HASH) 'BROWN
		 (GETHASH 'NAME HASH) 'FRED
		 (GETHASH 'AGE HASH) 29
		 (GETHASH 'PHONE HASH) '777-6551
		 (GETHASH 'HEIGHT HASH) '6-FEET
		 (GETHASH 'WEIGHT HASH) '170)
	(SETQ SPACE ":  ")
	(SETQ MESS0 "In this part of test, various lisp objects will be inspected.
Numbers except for complex and fraction types, and characters 
are not inspectable and an appropriate message will be printed.
If a inspect menu pops up, select the item INSPECT 
To create an inspector window, simply click the left mouse button
Please respond with y or n after an inspector window is created. ")
	(SETQ MESS1 "Is an inspector window created for ~A? ~%or a message displayed if ~A is not inspectable?")
	(SETQ MESS2 "Please indicate a position for inspecting
the compiled function COS with left mouse button")
	(SETQ MESS3 "Is the inspector window displayed for
the compiled function COS (Yes or NO?)")
	(SETQ MESS4 "Is the inspection information displayed
in the specified inspector window?")
	(SETQ MESS5 "The inspector window should have been created
for inspecting the compiled function COS")
	(SETQ MESS6 "Inspecting *random-state* never returns (AR 8203)
Please run this test after this test is completed by entering
(INSPECT *RANDOM-STATE*) and return Cont-E if it never returns.
If it still fails the test, please update the log file accordingly:
{eris}<lispcore>test>program-analysis>inspect.report.")
	(SETQ MESS7 "Are you ready to start testing(y or n)? ")
	(SETQ PROMPT-MESS "Item being inspected:  ")
	(SETQ PROMPT-MESS1 "Item just inspected: ~A: ~A~2%")
	
; Load TEDIT if not already loaded....
(IL:PAGEHEIGHT 0)
(IL:FILESLOAD (IL:SYSLOAD) TEDIT)

; Check the intial value of inspector variables...
(PASS-FAIL 'INITIAL-VALUES-OF-VARIABLES (AND (= IL:MAXINSPECTCDRLEVEL 50)
		(= IL:MAXINSPECTARRAYLEVEL 300)
		(EQUAL IL:INSPECTPRINTLEVEL '(2 . 5))
		(EQ IL:INSPECTALLFIELDSFLG T)))

; Create various objects to be inspected...
; Trying to inspect random state object will hang the system (never returns)
; A number or character cannot be inspected and an appropriate message should be
; generated for these objects... 
(SETQ INSPECT-ITEM-NAMES 
	'(ARRAY ATOM BIGNUM BIT BIT-VECTOR CHARACTER 
COMMON COMPILED-FUNCTION COMPLEX CONS 
DOUBLE-FLOAT FIXNUM FLOAT FUNCTION 
HASH-TABLE INTEGER KEYWORD LIST LONG-FLOAT 
NULL NUMBER PACKAGE PATHNAME  
RATIO RATIONAL READTABLE SEQUENCE 
SHORT-FLOAT SIMPLE-ARRAY SIMPLE-BIT-VECTOR 
SIMPLE-STRING SIMPLE-VECTOR SINGLE-FLOAT 
STANDARD-CHAR STREAM STRING STRING-CHAR 
SYMBOL T VECTOR WINDOW) ITEM-NAMES INSPECT-ITEM-NAMES)



(Y-OR-N-P MESS7)
(SETQ INSPECT-WINDOWS NIL)
(IL:FOR ITEM IL:IN INSPECT-ITEM-LIST IL:DO
			  (SETQ POP-ITEM (POP INSPECT-ITEM-NAMES))
			  (SETQ ITEM-VALUE (POP INSPECT-ITEM-LIST))
			  (IL:PROMPTPRINT PROMPT-MESS POP-ITEM SPACE ITEM-VALUE)
			  (INSPECT ITEM)
			  (FORMAT T PROMPT-MESS1 POP-ITEM ITEM-VALUE) 
			  (IL:SET (PACK* POP-ITEM '-INSPECTED-FLG)
					(Y-OR-N-P	(FORMAT T MESS1 POP-ITEM POP-ITEM)))
 )

(IL:FOR X IL:IN ITEM-NAMES IL:DO 
	(SETQ PF-ITEM (POP ITEM-NAMES))
	(PASS-FAIL X (EVAL (PACK* PF-ITEM '-INSPECTED-FLG))))


; Inspecting the compiled code of the function...
(IL:PROMPTPRINT MESS5)
(IL:INSPECTCODE 'COS)
(PASS-FAIL 'INSPECTCODE (Y-OR-N-P MESS3))

; Closing the inspector window...
(IL:FOR WINDOW IL:IN (IL:OPENWINDOWS)
	IL:DO (IL:CLOSEW WINDOW)
	IL:WHEN (STRING-EQUAL (IL:WINDOWPROP WINDOW 'IL:TITLE) INSPECTCODE-TITLE))

; Testing to see if an object could be displayed in a specified window...
(SETQ INSPECT-ARRAY (MAKE-ARRAY '(2 2) :INITIAL-CONTENTS '((1 2) (3 4))))
(IL:OPENW INSPECTORW)
(INSPECT INSPECT-ARRAY NIL INSPECTORW)
(PASS-FAIL 'INSPECT-WHERE (Y-OR-N-P MESS4))

; Delete all inspect windows that have been created...
(IL:FOR WINDOW IL:IN (IL:OPENWINDOWS)
	IL:DO (IL:CLOSEW WINDOW)
	IL:WHEN
	(AND (NOT (EQ (IL:WINDOWPROP WINDOW 'IL:TITLE) NIL))
		(OR (STRING-EQUAL (IL:WINDOWPROP WINDOW 'IL:TITLE)
				 INSPECTOR :start1 0 :end1 9)
			(STRING-EQUAL (IL:WINDOWPROP WINDOW 'IL:TITLE)
				 INSPECTOR 
				:start1 (- (LENGTH (IL:WINDOWPROP WINDOW 'IL:TITLE)) 9)
				:end1 (LENGTH (IL:WINDOWPROP WINDOW 'IL:TITLE))))
	)
)

; Test for AR8203
(IL:PROMPTPRINT MESS6)



TEST-SUCCEEDED
)

STOP