231 lines
8.0 KiB
Plaintext
231 lines
8.0 KiB
Plaintext
;; Function To Be Tested: . (MASTERSCOPE) (Program Analysis)
|
|
;;
|
|
;; Source: Lyric Release Overview (Lyric Beta Release)
|
|
;; Section 19 (Masterscope), Page 22
|
|
;; Section: Program Analysis
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: Feb 25, 1987
|
|
;;
|
|
;; Last Update: March 26, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>test>program-analysis>masterscope.u
|
|
;;
|
|
;;
|
|
;; Syntax: . &rest LINE
|
|
;;
|
|
;; Function Description: Make a MASTERSCOPE query. Masterscope is an interactive
|
|
;; program for analyzing and cross referencing user programs. It contains
|
|
;; facilities for analyzing user functions to determine what other functions are
|
|
;; called, how and where variables are bound, set, or referenced, as well as
|
|
;; which functions use particular record declarations. Masterscope is able to
|
|
;; analyze definitions directly from a file as well as in-core definitions.
|
|
;; This test is almost identical to the masterscope as an exec command, which is
|
|
;; located in {eris}<lispcore>test>exec>masterscope.u
|
|
;;
|
|
;; Argument(s): Masterscope commands (SEE IRM, Vol 3, Section 19)
|
|
;;
|
|
;; Returns: (SEE IRM, Vol 3, Section 19)
|
|
;;
|
|
;; Constraints/Limitations: Due to the nature of Programmer's Assistant commands,
|
|
;; testing them will be performed using do-test and the interlisp function bksysfuf.
|
|
;; Comments or messages are incorporated within
|
|
;; each command file, which will be run by using the function bksysbuf.
|
|
;; Each test setup is titled "MASTERSCOPE-TEST-SETUP", which executes the command
|
|
;; string. The do-test form within the command file will return T or "test
|
|
;; failed" This test file requires TEDIT and MASTERSCOPE package
|
|
;; The tree structure of the functions being analyzed are as follows:
|
|
;;
|
|
;; Top-Funtion
|
|
;; |
|
|
;; Fun-A------------------------Fun-B
|
|
;; | |
|
|
;; --------------------- --------------------
|
|
;; | | | | | |
|
|
;; Fun-A1 Fun-A2 Fun-A3 Fun-B1 Fun-B2 Fun-B3
|
|
;; |
|
|
;; --------------
|
|
;; | |
|
|
;; Fun-C1 Fun-A1
|
|
;;
|
|
;; Messages will be printed before each command in the command files is executed
|
|
;; for user monitoring. Test result is logged on
|
|
;; {eris}<lispcore>test>program-analysis>masterscope.report
|
|
|
|
(DO-TEST "MASTERSCOPE-TEST-SETUP"
|
|
(PROGN
|
|
(SETQ TEST-START (GET-INTERNAL-RUN-TIME))
|
|
(SETQ MESS1 "Now do-test will determine if correct results have been returned for the analysis of user functions...")
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>PROGRAM-ANALYSIS>MASTERSCOPE.REPORT")
|
|
(DEFUN R-FORMAT (STATUS)
|
|
(FORMAT *OUTPUT* "~%COMMAND: MASTERSCOPE~%LISP VERSION: ~A ~%STATUS: ~A DATE: ~A TESTER: ~A~%" (LISP-IMPLEMENTATION-VERSION) STATUS (IL:DATE) IL:USERNAME))
|
|
(DEFUN ITEM-FORMAT-S (COMMAND-LANGUAGE)
|
|
(FORMAT *OUTPUT* "~%COMMAND: MASTERSCOPE COMMAND LANGUAGE: ~A~%LISP VERSION: ~A ~%STATUS: ~A DATE: ~A TESTER: ~A~%" COMMAND-LANGUAGE (LISP-IMPLEMENTATION-VERSION) 'SUCCESS (IL:DATE) IL:USERNAME))
|
|
(DEFUN ITEM-FORMAT-F (COMMAND-LANGUAGE)
|
|
(FORMAT *OUTPUT* "~%COMMAND: MASTERSCOPE COMMAND LANGUAGE: ~A~%LISP VERSION: ~A ~%STATUS: ~A DATE: ~A TESTER: ~A~%" COMMAND-LANGUAGE (LISP-IMPLEMENTATION-VERSION) 'FAIL (IL:DATE) IL:USERNAME))
|
|
(SETQ {CORE}WHO-CALLS "{CORE}WHO-CALLS")
|
|
(SETQ {CORE}PATHS "{CORE}PATHS")
|
|
(SETQ {CORE}DESCRIBE "{CORE}DESCRIBE")
|
|
(SETQ MASTERSCOPE-COMMAND-STRING
|
|
"; Reinitialize and Define functions to be analyzed
|
|
. ERASE
|
|
(DEFUN TOP-FUNTION NIL (AND (FUN-A) (FUN-B)))
|
|
(DEFUN FUN-A NIL (OR (FUN-A1) (FUN-A2) (FUN-A3)))
|
|
(DEFUN FUN-B NIL (OR (FUN-B1) (FUN-B2) (FUN-B3)))
|
|
(DEFUN FUN-A1 NIL T)
|
|
(DEFUN FUN-A2 NIL NIL)
|
|
(DEFUN FUN-A3 NIL T)
|
|
(DEFUN FUN-B1 NIL (AND (FUN-C1)(FUN-A1)))
|
|
(DEFUN FUN-B2 NIL NIL)
|
|
(DEFUN FUN-B3 NIL T)
|
|
(DEFUN FUN-C1 NIL NIL)
|
|
; Start analyzing functions in top-function
|
|
. ANALYZE TOP-FUNTION
|
|
. ANALYZE FUN-A
|
|
. ANALYZE FUN-B
|
|
. ANALYZE FUN-B1
|
|
. WHO CALLS FUN-A1
|
|
(IF (EQUAL * '(FUN-A FUN-B1)) (SETQ FUN-A1-CALL T) (SETQ FUN-A1-CALL NIL))
|
|
. WHO CALLS TOP-FUNTION
|
|
(IF (EQUAL * NIL) (SETQ TOP-FUN-CALL T) (SETQ TOP-FUN-CALL NIL))
|
|
. WHO CALLS FUN-A
|
|
(IF (EQUAL * '(TOP-FUNTION)) (SETQ FUN-A-CALL T) (SETQ FUN-A-CALL NIL))
|
|
. WHO CALLS FUN-B2
|
|
(IF (EQUAL * '(FUN-B)) (SETQ FUN-B-CALL T) (SETQ FUN-B-CALL NIL))
|
|
(DRIBBLE '{CORE}WHO-CALLS)
|
|
. WHO CALLS WHO
|
|
(DRIBBLE)
|
|
(DRIBBLE '{CORE}PATHS)
|
|
. SHOW PATHS TO FUN-A1 FROM TOP-FUNTION
|
|
(DRIBBLE)
|
|
|
|
; ERASE (erase all information about the functions in SET from the database)
|
|
|
|
. WHO CALLS FUN-A1
|
|
. ERASE FUN-A
|
|
. WHO CALLS FUN-A1
|
|
(IF (EQUAL * '(FUN-B1)) (SETQ FUN-A-ERASED T) (SETQ FUN-A-ERASED NIL))
|
|
(SETQ ALL-ERASED-FLG NIL)
|
|
. ERASE
|
|
. WHO CALLS FUN-A
|
|
(IF (EQUAL * NIL) (PUSH T ALL-ERASED-FLG) (PUSH NIL ALL-ERASED-FLG))
|
|
. WHO CALLS FUN-B2
|
|
(IF (EQUAL * NIL) (PUSH T ALL-ERASED-FLG) (PUSH NIL ALL-ERASED-FLG))
|
|
. WHO CALLS FUN-B2
|
|
(IF (EQUAL * NIL) (PUSH T ALL-ERASED-FLG) (PUSH NIL ALL-ERASED-FLG))
|
|
|
|
; REANALYZE (causes masterscope to reanalyze the functions in SET)
|
|
. ANALYZE TOP-FUNTION
|
|
. ANALYZE FUN-A
|
|
. ANALYZE FUN-B
|
|
. ANALYZE FUN-B1
|
|
. ERASE FUN-A
|
|
. REANALYZE FUN-A
|
|
. WHO CALLS FUN-A1
|
|
(IF (EQUAL * '(FUN-B1 FUN-A)) (SETQ REANALYZED-FLG T) (SETQ REANALYZED-FLG NIL))
|
|
|
|
. ERASE
|
|
;SET ARE SET
|
|
|
|
. WHO IS CALLED BY TOP-FUNTION
|
|
(IF (EQUAL * '(FUN-A FUN-B)) (SETQ CALLED-BY-FLG T) (SETQ CALLED-BY-FLG NIL))
|
|
|
|
|
|
; DESCRIBE SET (prints out the bind, use freely and call information)
|
|
|
|
(DEFUN FUN-DESCRIBE (X Y) (PROGN (SETQ X1 (1+ X)) (SETQ Y1 (1- Y))))
|
|
. ANALYZE FUN-DESCRIBE
|
|
(DRIBBLE '{CORE}DESCRIBE)
|
|
. DESCRIBE FUN-DESCRIBE
|
|
(DRIBBLE)
|
|
. ERASE
|
|
; analyzing the file that contains describe results
|
|
(SETQ DESCRIBE-LIST '(| calls: 1+,1-| | binds: x,y| | uses free: y1,x1|))
|
|
(SETQ DESCRIBE-FLG NIL)
|
|
(SETQ DESCRIBE-FILE (OPEN {CORE}DESCRIBE))
|
|
(DO (( i 0 (1+ i)))
|
|
((= i 4) t)
|
|
(READ-LINE DESCRIBE-FILE))
|
|
(DOLIST (Y DESCRIBE-LIST) (IF (STRING-EQUAL Y (READ-LINE DESCRIBE-FILE))
|
|
(PUSH T DESCRIBE-FLG)
|
|
(PUSH NIL DESCRIBE-FLG)))
|
|
(CLOSE DESCRIBE-FILE)
|
|
(DELETE-FILE {CORE}DESCRIBE)
|
|
|
|
; analyzing the file that contains the previous masterscope interactions
|
|
; (who calls?)
|
|
(SETQ CALL-LIST '(|fun-b -- (fun-b1 fun-b2 fun-b3)|
|
|
|fun-a -- (fun-a1 fun-a2 fun-a3)|
|
|
|top-funtion -- (fun-a fun-b)|
|
|
|fun-b1 -- (fun-c1 fun-a1)|
|
|
))
|
|
|
|
(SETQ WHO-CALLS-FLG NIL)
|
|
(SETQ WHO-CALLS (OPEN {CORE}WHO-CALLS))
|
|
(READ-LINE WHO-CALLS)
|
|
(READ-LINE WHO-CALLS)
|
|
(READ-LINE WHO-CALLS)
|
|
(DOLIST (Y CALL-LIST) (IF (STRING-EQUAL Y (READ-LINE WHO-CALLS))
|
|
(PUSH T WHO-CALLS-FLG)
|
|
(PUSH NIL WHO-CALLS-FLG)))
|
|
(CLOSE WHO-CALLS)
|
|
; analyzing the file that contains the masterscope interaction (show paths)
|
|
(SETQ PATHS (OPEN {CORE}PATHS))
|
|
(DO (( i 0 (1+ i)))
|
|
((= i 5) t)
|
|
(READ-LINE PATHS))
|
|
|
|
(IF (AND (STRING-EQUAL (READ-LINE PATHS) '|1.fun-a1 fun-a top-funtion|)
|
|
(STRING-EQUAL (READ-LINE PATHS) '|2. fun-b1 fun-b top-funtion|))
|
|
(SETQ PATHS-FLG T)(SETQ PATHS-FLG NIL))
|
|
(CLOSE PATHS)
|
|
(DELETE-FILE '{CORE}PATHS)
|
|
(DELETE-FILE '{CORE}WHO-CALLS)
|
|
(FORMAT NIL MESS1)
|
|
(DEFUN PASS-FAIL (COMMAND-LANGUAGE TEST-ITEM)
|
|
(IF (EQ TEST-ITEM T) (ITEM-FORMAT-S COMMAND-LANGUAGE)
|
|
(ITEM-FORMAT-F COMMAND-LANGUAGE)))
|
|
(SETQ TEST-END (GET-INTERNAL-RUN-TIME))
|
|
(SETQ TOTAL-TEST-TIME (FLOAT (/ (- TEST-END TEST-START) 60000)))
|
|
|
|
(DO-TEST 'MASTERSCOPE-TEST-RESULT
|
|
(PROG2 (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(IF (AND (EQ FUN-A1-CALL T)
|
|
(EQ TOP-FUN-CALL T)
|
|
(EQ FUN-A-CALL T)
|
|
(EQ FUN-B-CALL T)
|
|
(EQ PATHS-FLG T)
|
|
(EQ FUN-A-ERASED T)
|
|
(NOTANY #'NULL ALL-ERASED-FLG)
|
|
(EQ REANALYZED-FLG T)
|
|
(EQ CALLED-BY-FLG T)
|
|
(NOTANY #'NULL DESCRIBE-FLG)
|
|
(NOTANY #'NULL WHO-CALLS-FLG))
|
|
(PROGN (R-FORMAT 'SUCCESS) T)
|
|
(PROGN (R-FORMAT 'FAIL) NIL))
|
|
(PASS-FAIL 'WHO-CALLS
|
|
(NOTANY #'NULL WHO-CALLS-FLG))
|
|
(PASS-FAIL 'SHOW-PATHS PATHS-FLG)
|
|
(PASS-FAIL 'ERASED (AND FUN-A-ERASED
|
|
(NOTANY #'NULL ALL-ERASED-FLG)))
|
|
(PASS-FAIL 'WHO-IS-CALLED-BY CALLED-BY-FLG)
|
|
(PASS-FAIL 'REANALYZE REANALYZED-FLG)
|
|
(PASS-FAIL 'DESCRIBE (NOTANY #'NULL DESCRIBE-FLG))
|
|
(T-FORMAT TOTAL-TEST-TIME)
|
|
(CLOSE *OUTPUT*)
|
|
)
|
|
)
|
|
|
|
")
|
|
(IL:BKSYSBUF MASTERSCOPE-COMMAND-STRING)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|