191 lines
7.0 KiB
Plaintext
191 lines
7.0 KiB
Plaintext
;; Function To Be Tested: DATABASEFNS (Program Analysis)
|
|
;;
|
|
;; Source: Lisp Library Modules Manual (Lyric Beta Release 2)
|
|
;; Browser, Page 11
|
|
;; Section: Program Analysis (Library)
|
|
;;
|
|
;; Created By: John Park
|
|
;;
|
|
;; Creation Date: March 18, 1987
|
|
;;
|
|
;; Last Update: March 20, 1987
|
|
;;
|
|
;; Filed As: {ERIS}<lispcore>test>program-analysis>databasefns.u
|
|
;;
|
|
;;
|
|
;; Syntax: (DUMPDB FILE) & (LOADDB FILE)
|
|
;;
|
|
;; Function Description: DATABASEFNS is a very small package whose purpose is to make
|
|
;; the construction and maintenance of masterscope data bases an essentially automatic
|
|
;; process. It modifies MAKEFILE, LOAD, and LOADFROM to update database for masterscope.
|
|
;; For more info, refer to Lisp Library Modules Manual, Lyric beta release.
|
|
;; The user can dump and restore data bases explicitly via the following functions:
|
|
;; (DUMPDB file) - Dumps a data base for FILE then sets the DATABASE property to YES,
|
|
;; so that data base maintenance for FILE will subsequently be automatic.
|
|
;; (LOADDB file) - Loads the file FILE.DATABASE if one exists. After the data base is
|
|
;; loaded, the DATABASE property for FILE is set to YES, so that maintenance will be
|
|
;; thereafter automatic.
|
|
;;
|
|
;; Argument(s): (SEE Databasefns documentation)
|
|
;;
|
|
;; Returns: (SEE Databasefns documentation)
|
|
;;
|
|
;; Constraints/Limitations: The primary emphasis of this testing is the explicit
|
|
;; dumpting and restoration of data bases. 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>databasefns.report. This test requires
|
|
;; DATABASEFNS, TEDIT, and MASTERSCOPE.
|
|
;;
|
|
;;
|
|
;;
|
|
(DO-TEST "DATABASEFNS-TEST-SETUP"
|
|
(PROGN
|
|
(SETQ TEST-START (GET-INTERNAL-RUN-TIME))
|
|
(SETQ TEST-RESULT "{ERIS}<LISPCORE>TEST>PROGRAM-ANALYSIS>DATABASEFNS.REPORT")
|
|
(DEFUN T-FORMAT (TIME)
|
|
(FORMAT *OUTPUT* "~2%TOTAL TEST RUN TIME FOR DATABASEFNS: ~F MINUTES ~%"
|
|
TIME))
|
|
|
|
(DEFUN ITEM-FORMAT-S (COMMAND-LANGUAGE)
|
|
(FORMAT *OUTPUT* "~%COMMAND: DATABASEFNS TEST-ITEM: ~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: DATABASEFNS TEST-ITEM: ~A~%LISP VERSION: ~A ~%STATUS: ~A DATE: ~A TESTER: ~A~%" COMMAND-LANGUAGE (LISP-IMPLEMENTATION-VERSION) 'FAIL (IL:DATE) IL:USERNAME))
|
|
(DEFUN PASS-FAIL (COMMAND-LANGUAGE TEST-ITEM)
|
|
(IF (EQ TEST-ITEM T) (ITEM-FORMAT-S COMMAND-LANGUAGE)
|
|
(ITEM-FORMAT-F COMMAND-LANGUAGE)))
|
|
(DEFUN PAUSE NIL (PROGN
|
|
(IL:PLAYTUNE '((262 . 15000) (440 . 15000) (349 . 15000)))
|
|
(SLEEP 2)))
|
|
(SETQ DATABASEFNSW (IL:CREATEW '(100 100 325 90) NIL NIL T))
|
|
(SETQ DATABASEFNS-COMMAND-STRING
|
|
"; Loading databasefns and other required files from {erinyes}<lyric>library>....
|
|
(PAUSE)
|
|
(IL:PAGEHEIGHT 0)
|
|
(IL:LOAD? '{ERINYES}<LYRIC>LIBRARY>TEDIT.LCOM 'IL:SYSLOAD)
|
|
(IL:LOAD? '{ERINYES}<LYRIC>LIBRARY>MASTERSCOPE.LCOM 'IL:SYSLOAD)
|
|
(IL:LOAD '{ERINYES}<LYRIC>LIBRARY>DATABASEFNS.LCOM 'IL:SYSLOAD)
|
|
|
|
; Copy the necessary source file (data) to {core}
|
|
(IL:COPYFILE '{ERIS}<LISPCORE>TEST>PROGRAM-ANALYSIS>DATABASEFNS.DATA
|
|
'{CORE}NEW-FUNCTION)
|
|
CONN {CORE}
|
|
(PAUSE)
|
|
; This tests to see if the global variable LOADDBFLG and SAVEDBFLG are initially
|
|
; set to ASK
|
|
(IF (AND (EQ IL:LOADDBFLG 'IL:ASK) (EQ IL:SAVEDBFLG 'IL:ASK))
|
|
(SETQ DB-VARIABLES-FLG T)
|
|
(SETQ DB-VARIABLES-FLG NIL))
|
|
|
|
|
|
|
|
; This part of the test loads the initial data file for masterscope analysis
|
|
(IL:PROMPTPRINT '(Please enter Y when masterscope asks for loading))
|
|
(SETF (GET 'IL:NEW-FUNCTION 'IL:DATABASE) 'IL:YES)
|
|
(LOAD '{CORE}NEW-FUNCTION)
|
|
. ANALYZE FUNCTIONS ON {CORE}NEW-FUNCTION
|
|
. WHO IS CALLED BY IL:NEW-FUNCTION
|
|
(SETQ OLD-CALL-LIST *)
|
|
(IL:CLRPROMPT)
|
|
|
|
; New-function is redefined; it also utilized times function ...
|
|
(IL:DEFINEQ (IL:NEW-FUNCTION (X Y) (IL:PLUS (IL:PLUS X Y) (IL:TIMES X Y))))
|
|
. WHO IS CALLED BY IL:NEW-FUNCTION
|
|
(SETQ NEW-CALL-LIST *)
|
|
(IF (EQUAL (SET-DIFFERENCE NEW-CALL-LIST OLD-CALL-LIST) '(IL:TIMES))
|
|
(SETQ DB-UPDATE-FLG T)
|
|
(SETQ DB-UPDATE-FLG NIL))
|
|
(IL:DUMPDB '{CORE}NEW-FUNCTION)
|
|
(SETF (GET 'IL:NEW-FUNCTION 'IL:DATABASE) 'IL:NO)
|
|
(IF (PROBE-FILE '{CORE}NEW-FUNCTION.DATABASE)
|
|
(SETQ DB-CREATED-FLG T)
|
|
(SETQ DB-CREATED-FLG NIL))
|
|
(IL:REMPROP 'IL:NEW-FUNCTION 'IL:DATABASE)
|
|
(IL:LOADDB '{CORE}NEW-FUNCTION)
|
|
(IF (EQ (GET 'IL:NEW-FUNCTION 'IL:DATABASE) 'IL:YES)
|
|
(SETQ DB-FLG-RESET T)
|
|
(SETQ DB-FLG-RESET NIL))
|
|
|
|
; Loading the database file will reset the property database with 'YES values
|
|
; and make masterscope database maintenance automatic..
|
|
; Cleanup will do recompilation and generate the updated database
|
|
(PAUSE)
|
|
(IL:PROMPTPRINT '(enter n it the system asks you to save any variables:
|
|
enter y if the system asks you if you want a masterscope database))
|
|
(IL:CLEANUP)
|
|
|
|
; Now new souce and compiles files and corresponding database should have been
|
|
; created
|
|
(IF (AND (PROBE-FILE '{CORE}NEW-FUNCTION)
|
|
(PROBE-FILE '{CORE}NEW-FUNCTION.DFASL)
|
|
(PROBE-FILE '{CORE}NEW-FUNCTION.DATABASE))
|
|
(SETQ DB-CREATED-MAKEFILE T)
|
|
(SETQ DB-CREATED-MAKEFILE NIL))
|
|
(SETF (GET 'IL:NEW-FUNCTION 'IL:DATABASE) 'IL:NO)
|
|
|
|
; Displaying the database that has been created in a tedit window...
|
|
(IL:PROMPTPRINT '(Displaying the database in a tedit window...))
|
|
(PAUSE)
|
|
(SETQ DATA-WINDOW (IL:CREATEW '(750 50 400 500) 'DATABASE-WINDOW))
|
|
(SETQ DATA-STREAM (IL:OPENTEXTSTREAM '{CORE}NEW-FUNCTION.DATABASE
|
|
DATA-WINDOW ))
|
|
(SLEEP 4)
|
|
(CLOSE DATA-STREAM)
|
|
(IL:CLOSEW DATA-WINDOW)
|
|
|
|
; Erasing masterscope record for NEW-FUNCTION....
|
|
. ERASE IL:NEW-FUNCTION
|
|
(IL:PROMPTPRINT '(. who calls who should now return nil))
|
|
(PAUSE)
|
|
. WHO IS CALLED BY IL:NEW-FUNCTION
|
|
|
|
; Setting the variable LOADDBFLG to NO will not load the database file...
|
|
(IL:REMPROP 'IL:NEW-FUNCTION 'IL:DATABASE)
|
|
(SETQ IL:LOADDBFLG 'IL:NO)
|
|
(IL:LOAD '{CORE}NEW-FUNCTION)
|
|
(IF (EQ (GET 'IL:NEW-FUNCTION 'IL:DATABASE) 'IL:NONE)
|
|
(SETQ DB-NOT-LOADED T) (SETQ DB-NOT-LOADED NIL))
|
|
|
|
; Setting the variable LOADDBFLG to YES will load the database file...
|
|
(SETQ IL:LOADDBFLG 'IL:YES)
|
|
(IL:LOAD '{CORE}NEW-FUNCTION)
|
|
(IF (EQ (GET 'IL:NEW-FUNCTION 'IL:DATABASE) 'IL:YES)
|
|
(SETQ DB-LOADED T) (SETQ DB-LOADED NIL))
|
|
|
|
|
|
; Now delete all the files except for the original file for new-function
|
|
(MAPCAR #'DELETE-FILE (IL:DIRECTORY '{CORE}))
|
|
|
|
CONN {DSK}
|
|
(IL:CLRPROMPT)
|
|
(SETQ IL:LOADDBFLG 'IL:ASK)
|
|
(SETQ TEST-END (GET-INTERNAL-RUN-TIME))
|
|
(SETQ TOTAL-TEST-TIME (FLOAT (/ (- TEST-END TEST-START) 60000)))
|
|
|
|
(DO-TEST 'DATABASEFNS-TEST-RESULT
|
|
(PROGN (SETQ *OUTPUT* (OPEN TEST-RESULT :DIRECTION :OUTPUT
|
|
:IF-EXISTS :APPEND))
|
|
(PASS-FAIL 'DABASEFNS-VARIABLES DB-VARIABLES-FLG)
|
|
(PASS-FAIL 'DATABASE-UPDATE DB-UPDATE-FLG)
|
|
(PASS-FAIL 'DATABASE-CREATED DB-CREATED-FLG)
|
|
(PASS-FAIL 'DATABASE-PROP-RESET DB-FLG-RESET)
|
|
(PASS-FAIL 'DATABASE-CREATED-BY-MAKEFILE DB-CREATED-MAKEFILE)
|
|
(PASS-FAIL 'LOADDB-FLG-NO DB-NOT-LOADED)
|
|
(PASS-FAIL 'LOADDB-FLG-YES DB-LOADED)
|
|
(T-FORMAT TOTAL-TEST-TIME)
|
|
(CLOSE *OUTPUT*)
|
|
(IDENTITY T)
|
|
)
|
|
)
|
|
|
|
")
|
|
(IL:BKSYSBUF DATABASEFNS-COMMAND-STRING)
|
|
)
|
|
)
|
|
|
|
STOP
|
|
|
|
|
|
|
|
|