(FILECREATED " 2-Jan-86 17:53:57" {PHYLUM}<LOOPS>SOURCES>TESTER>LTBASIC.;2 23288 changes to: (VARS LTBASICCOMS) previous date: "18-Mar-85 16:57:30" {PHYLUM}<LOOPS>SOURCES>TESTER>LTBASIC.;1) (* Copyright (c) 1984, 1985, 1986 by Xerox Corporation. All rights reserved.) (PRETTYCOMPRINT LTBASICCOMS) (RPAQQ LTBASICCOMS [(CLASSES AllTestBrowser SubTestBrowser TestBrowser FailedTestBrowser) (METHODS FailedTestBrowser.LeftShiftSelect TestBrowser.BoxNode TestBrowser.FlashNode TestBrowser.FlipNode TestBrowser.GetSubs TestBrowser.LeftShiftSelect TestBrowser.MiddleShiftSelect TestBrowser.Recompute) (FNS CopyTester EditATest LTCompInt LoadLTIfNeeded LoadLTSystem LoadLTSystemCI LoadNeededFiles MakeTester MenuEval ResetLTBASICVARS ResetFailedTests ResetLoopsTester SetUpTestBrowser SetUpLoopsTest SetupLoopsTest2 TestForever TestLoadedInstances) (MACROS PrintIfLev) [INITVARS (CoreTesterFiles (QUOTE (LTBASIC LTSUB LTKER LTCASES LTFILES] (VARS * LTBASICVARS) (VARS (BrkErrorFlg NIL)) (FILES (SYSLOAD FROM LISPUSERS) TMENU) [P (ResetLTBASICVARS) (SETQ CurrentEnvironment NIL) (SetUpLoopsTest) (COND ((NULL (GetClassRec (QUOTE KB))) (SETQ KBTestsFlg NIL] (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA MenuEval) (NLAML) (LAMA]) (DEFCLASSES AllTestBrowser SubTestBrowser TestBrowser FailedTestBrowser) [DEFCLASS AllTestBrowser (MetaClass Class Edited: (* sm: "30-MAR-83 11:07")) (Supers TestBrowser) (InstanceVariables (title "TEST BROWSER:: [Tests on the right depend on the left ones. ALL tests are shown]") (window ? DefRegion (426 1 598 800)) (subLinks (PreTestOf SubTest)))] [DEFCLASS SubTestBrowser (MetaClass Class Edited: (* sm: "29-MAR-83 14:51")) (Supers TestBrowser) (InstanceVariables (title "SubTest Browser: Tests and their subtests") (window ? DefRegion (426 540 598 150)) (subLinks (SubTest)))] [DEFCLASS TestBrowser (MetaClass Class Edited: (* sm: "31-MAY-83 16:10")) (Supers LatticeBrowser) (ClassVariables (LeftButtonItems (("Test" (QUOTE TEST) "Test this node, if PreTests succeed") ("TestSelf" (QUOTE TestSelf) "Test this node, even if PreTests fail") ("ReTest" (QUOTE ReTest) "test this node, resetting results from previous test if any") ("ReTestDep" (QUOTE ReTestDep) "retest this node and its dependents") ("EditTest" (QUOTE EditTestInTTYProcess) "edit this test interactively ") ("Describe" (QUOTE Describe) "describe the test object and results of any test") ("Reset" (QUOTE ResetSelf) "reset results from previous test") ("ResetPre" (QUOTE Reset) "reset it and its pretests") ("Test all" (QUOTE TESTall) "test it, subtests and others which depend on it") ("Test sub" (QUOTE TEST!) "test it, subtests, syntax etc") ("Reset sub" (QUOTE Reset!) "reset it and its subtests"))) (MiddleButtonItems (PP PP! EEObject Recompute Unread)) (LocalCommands (EEObject Recompute Unread))) (InstanceVariables (title "TEST BROWSER:: [Tests on the RIGHT depend on the left ones; SubTests not shown] ") (window ? DefRegion (426 210 598 600)) (subLinks (PreTestOf) doc (* list of links used to create SUBS list for browser) ))] [DEFCLASS FailedTestBrowser (MetaClass Class Edited: (* sm: " 1-JUN-83 11:11")) (Supers TestBrowser) [ClassVariables (LeftButtonItems (("ReTest" (QUOTE ReTest) "test this node, resetting results from previous test if any") ("TestSelf" (QUOTE TestSelf) "Test this node, even if its PreTests failed") ("ReTestDep" (QUOTE ReTestDep) "retest this node and all others which depend on it") ("EditTest" (QUOTE EditTestInTTYProcess) "edit this test interactively ") ("Describe" (QUOTE Describe) "describe the test object and results of any test") ("Reset" (QUOTE ResetSelf) "reset results from previous test") ("ResetDep" (QUOTE ResetDep) "reset it and those which depend on it"] (InstanceVariables (title "Failed/Incomplete Tests and their PreTests") (subLinks (PreTest)) (window ? DefRegion (426 210 598 280)))] [METH FailedTestBrowser LeftShiftSelect (obj objName) (* action for LeftShift selection)] [METH TestBrowser BoxNode (obj) NIL] [METH TestBrowser FlashNode (node N flashTime) NIL] [METH TestBrowser FlipNode (obj) NIL] [METH TestBrowser GetSubs (elt) (* returns the list of objects which are "subs" of "elt" using the value of IV "subLinks" in the browser to determine the links to be used)] [METH TestBrowser LeftShiftSelect (obj objName) (* action to be performed for LeftShift selection)] [METH TestBrowser MiddleShiftSelect (obj objName) (* action for MiddleShift selection)] [METH TestBrowser Recompute NIL (* inherits Recompute from Super and does TickleBrowserNodes)] (DEFINEQ (FailedTestBrowser.LeftShiftSelect (Method ((FailedTestBrowser LeftShiftSelect) self obj objName) (* sm: "25-NOV-82 15:46") (* action for LeftShift selection) (← obj ReTest))) (TestBrowser.BoxNode (Method ((TestBrowser BoxNode) self obj) (* sm: "10-DEC-82 17:35") (COND ((← self HasObject obj) (←Super self BoxNode obj)) (T NIL)))) (TestBrowser.FlashNode [Method ((TestBrowser FlashNode) self node N flashTime) (* sm: "25-NOV-82 15:17") (COND ((← self HasObject node) (←Super self FlashNode node N flashTime]) (TestBrowser.FlipNode (Method ((TestBrowser FlipNode) self obj) (* sm: "25-NOV-82 15:19") (COND ((← self HasObject obj) (←Super self FlipNode obj)) (T NIL)))) (TestBrowser.GetSubs [Method ((TestBrowser GetSubs) self elt) (* sm: "11-NOV-82 17:15") (* returns the list of objects which are "subs" of "elt" using the value of IV "subLinks" in the browser to determine the links to be used) (PROG (Subs) (SETQ elt (GetObjectRec elt)) (for x in (MKLIST (@ subLinks)) do (SETQ Subs (APPEND (GetValue elt x) Subs))) (RETURN (MAPCAR Subs (QUOTE (LAMBDA (X) (GetObjectRec X]) (TestBrowser.LeftShiftSelect (Method ((TestBrowser LeftShiftSelect) self obj objName) (* sm: "25-NOV-82 15:44") (* action to be performed for LeftShift selection) (← obj TEST))) (TestBrowser.MiddleShiftSelect (Method ((TestBrowser MiddleShiftSelect) self obj objName) (* sm: "25-NOV-82 15:45") (* action for MiddleShift selection) (← obj EditTEST))) (TestBrowser.Recompute (Method ((TestBrowser Recompute) self) (* sm: "12-NOV-82 14:26") (* inherits Recompute from Super and does TickleBrowserNodes) (←Super self Recompute) (TickleBrowserNodes (GetValue self (QUOTE startingList)) self))) ) (DEFINEQ (CopyTester [LAMBDA (ToDir FromDir) (* sm: "14-Dec-84 10:17") (* copies tester from FromDir to ToDir.) (* FromDir defaults to {IVY}<MITTAL>LISP>. ToDir defaults to {indigo}<KBVLSI>LOOPS>SOURCES>) (PROG (from to) (SETQ to (OR ToDir (QUOTE {INDIGO}<LOOPS>SOURCES>))) (SETQ from (OR FromDir (QUOTE {PHYLUM}<MITTAL>LISP>))) [for x in MainTesterFiles do (COPYFILE (MKNAME (CONCAT from x)) (MKNAME (CONCAT to x] [for x in CompiledTesterFiles do (COPYFILE (MKNAME (CONCAT from x ".DCOM")) (MKNAME (CONCAT to x ".DCOM"] (printout TTY "Copied source files" -3 MainTesterFiles -3 "from: " from -3 "to: " to T) (printout TTY "Copied compiled files" -3 CompiledTesterFiles -3 "from: " from -3 "to: " to T) (RETURN MainTesterFiles]) (EditATest [LAMBDA NIL (* sm: " 1-JUN-83 11:10") (PROG NIL (LoadLTIfNeeded) (EVAL.IN.TTY.PROCESS (LIST (QUOTE SEND) (GetObjectRec (PromptRead "ObjName:")) (QUOTE EditTEST]) (LTCompInt [LAMBDA NIL (* sm: " 5-Jun-84 10:42") (* asks whether you want to run the tester compiled or interpreted) (PROG (res) (SETQ res (INMENU "Should I use compiled or interpreted versions of tester files?" (QUOTE (Compiled Interpreted)) "C for compiled, I for interpreted versions" T)) (RETURN (SETQ LTCompIntFlg (COND ((EQ res (QUOTE Compiled)) NIL) (T T]) (LoadLTIfNeeded [LAMBDA NIL (* sm: "31-MAY-83 10:10") (COND ((NOT LTLOADEDREST) (LoadLTSystem LTCompIntFlg]) (LoadLTSystem [LAMBDA (compIntFlg) (* sm: "18-Mar-85 16:21") (* load rest of TestLOOPS system) (* If compIntFlg is T loads source versions, else compiled) (PROG (saveFlg) (SETQ saveFlg LTCompIntFlg) (SETQ LTCompIntFlg compIntFlg) (for x in (LDIFFERENCE CoreTesterFiles (QUOTE (LTBASIC))) do (LTLoadFile? x)) (SETQ LTCompIntFlg saveFlg) (SETQ LTLOADEDREST T]) (LoadLTSystemCI [LAMBDA NIL (* sm: "31-MAY-83 09:57") (* calls LoadLTSystem with the LTCompIntFlg to cause Compiled or Interpreted versions to be loaded) (LoadLTSystem LTCompIntFlg]) (LoadNeededFiles [LAMBDA (options) (* sm: "15-Mar-85 16:11") (* loads rest of tester as specified by options) (DOFILESLOAD (REMOVE (QUOTE LTBASIC) CoreTesterFiles)) [COND ((NULL options) (DOFILESLOAD StandardTestFiles)) ((EQ options T)) ((AND (LITATOM options) (BOUNDP options)) (DOFILESLOAD (EVALV options] (SETQ LTLOADEDREST T]) (MakeTester [LAMBDA (ToDir FromDir) (* sm: "14-Dec-84 10:16") (* copies tester from FromDir to ToDir.) (* FromDir defaults to {IVY}<MITTAL>LISP>. ToDir defaults to {indigo}<KBVLSI>LOOPS>SOURCES>) (PROG (from to) (SETQ to (OR ToDir (QUOTE {INDIGO}<LOOPS>SOURCES>))) (SETQ from (OR FromDir (QUOTE {PHYLUM}<MITTAL>LISP>))) [for x in (LDIFFERENCE MainTesterFiles CompiledTesterFiles) do (COPYFILE (MKNAME (CONCAT from x)) (MKNAME (CONCAT to x] [for x in CompiledTesterFiles do (CNDIR from) (LOAD x) (CNDIR to) (MAKEFILE x (QUOTE (C F] (CNDIR from) (printout TTY "Made new source files" -3 MainTesterFiles -3 "from: " from -3 "to: " to T) (printout TTY "Compiled files" -3 CompiledTesterFiles -3 "from: " from -3 "to: " to T) (RETURN MainTesterFiles]) (MenuEval [NLAMBDA Exps (* sm: " 1-NOV-82 11:13") (* evaluates each of Exp in Exps. Returns "") (PROG NIL (for x in Exps do (ERRORSET x T)) (RETURN ""]) (ResetLTBASICVARS [LAMBDA NIL (* sm: "31-MAY-83 09:44") [SETQ LTLOADEDREST (SETQ LTBROWSER (SETQ LTError (SETQ LTMBROWSER (SETQ LTABROWSER NIL] (SETQ LTLOGFLAG T) (SETQ LTDontAsk NIL) (SETQ LTCompIntFlg NIL) (SETQ LTResult T) (SETQ LTMsgLev 8) (SETQ LTInitW NIL]) (ResetFailedTests [LAMBDA NIL (* sm: "31-MAY-83 15:23") (* resets failed tests and sets up things for doing retest) (PROG ((ResetLst (CONS))) (SETQ LTBROWSER LTABROWSER) [COND ((OR (NOT LTLOADEDREST) (NULL LTABROWSER)) (RETURN (InteractiveLoopsTest] (for x in (APPEND Failed NotDone) do (ERSETQ (← (GetObjectRec x) Reset! ResetLst))) (LTLoadFile (QUOTE LTBCLS)) (LTLoadFile (QUOTE LTCASES)) (RETURN T]) (ResetLoopsTester [LAMBDA NIL (* sm: "31-MAY-83 15:26") (* resets tester and sets up things for doing retest) (PROG ((Imode LTMBROWSER) (CompIntFlg LTCompIntFlg) (ResetLst (CONS)) (FB LTABROWSER)) (SETQ LTBROWSER LTMBROWSER) [COND ((NOT LTLOADEDREST) (RETURN (SetUpTestBrowser] (for x in (REVERSE Tested) do (← (GetObjectRec x) ResetSelf ResetLst)) (LTLoadFile (QUOTE LTBCLS)) (LTLoadFile (QUOTE LTCASES)) (ResetLTBASICVARS) (SETQ LTCompIntFlg CompIntFlg) (SETQ LTLOADEDREST T) (SETQ LTABROWSER FB) (COND (Imode (CLOSEW (GetValue Imode (QUOTE window))) (SETQ LTABROWSER NIL) (SetUpTestBrowser))) (COND (LTABROWSER (TOTOPW (GetValue LTABROWSER (QUOTE window))) (SETQ LTBROWSER LTABROWSER))) (RETURN T]) (SetUpTestBrowser [LAMBDA NIL (* sm: " 1-MAR-83 15:02") (* Brings up the Test browser) (LoadLTIfNeeded) (SETQ LTMBROWSER (SETQ LTBROWSER (DisplayTestBrowser (CAR (GenerateTestList)) (QUOTE TestBrowser]) (SetUpLoopsTest [LAMBDA NIL (* sm: "18-Mar-85 16:01") (* setups the initial menu for testing) (PROG (INP INP2 (Redo T)) [SETQ LTInitW (TMenu (QUOTE (("Test Interactively" (QUOTE (InteractiveLoopsTest)) "test in a interactive mode" " ") ("Basic Tests" (QUOTE (PROGN (LOAD (QUOTE LTBCLS)) (BasicTest))) "run basic tests" " ") ("Rest of Tests" (QUOTE (PROGN (LoadLTIfNeeded) (BeginLoopsTest))) "run rest of the tests" " ") ("All Tests" (QUOTE (PROGN (BasicTest) (LoadLTIfNeeded) (BeginLoopsTest))) "perform all tests" " ") ("Test from files" (TestFromFiles) "Loads tests from selected files and runs them") ("Reset Failed Tests" (QUOTE (ResetFailedTests)) "reset the failed tests" " ") ("Reset Tester" (QUOTE (ResetLoopsTester)) "reset the tester" " ") ("Edit a Test" (QUOTE (EditATest)) "EditTEST a selected object" " ") ("Compiled/Interpreted" (QUOTE (LTCompInt)) "asks whether you want to run tester compiled or interpreted" " ") ("Load System" (QUOTE (LoadLTSystemCI)) "load rest of system: compiled or interpreted based on LTCompIntFlg" " ") ("Cleanup" (QUOTE (CleanupTester)) "cleans up by deleting temporary files" " ") ("Quit" (QUOTE (CLOSEW LTInitW)) "quit from testing mode" " "))) "LoopsTest Cmds" (QUOTE (5 190 150 240] (RETURN T]) (SetupLoopsTest2 [LAMBDA NIL (* sm: "20-SEP-83 16:36") (* setups the initial menu for testing) (PROG (INP INP2 (Redo T)) (SETQ LTInitW (TMenu (QUOTE (("Test Interactively" (MenuEval (InteractiveLoopsTest)) "test in a interactive mode") ("Basic Tests" (MenuEval (LOAD (QUOTE LTBCLS)) (BasicTest)) "run basic tests") ("Rest of Tests" (MenuEval (LoadLTIfNeeded) (BeginLoopsTest)) "run rest of the tests") ("All Tests" (MenuEval (BasicTest) (LoadLTIfNeeded) (BeginLoopsTest)) "perform all tests") ("Quit" (MenuEval (CLOSEW LTInitW)) "quit from testing mode") ("Reset Failed Tests" (MenuEval (ResetFailedTests)) "reset the failed tests") ("Reset Tester" (MenuEval (ResetLoopsTester)) "reset the tester") ("Edit a Test" (MenuEval (EditATest)) "EditTEST a selected object") ("Load System" (MenuEval (LoadLTSystem)) "load rest of system"))) "LoopsTest Cmds" (QUOTE (470 20 130 150)) T)) (* LOOP (ERSETQ (SELECTQ (SETQ INP (READ)) (B (TestLOOPS)) (ALL (LoadLTSystem)) (RB (LOAD (QUOTE LTBCLS)) (TestLOOPS)) (QUIT (SETQ Redo NIL)) (EDIT (PRIN1 "ObjName") (SETQ INP2 (READ)) (← (GetObjectRec INP2) EditTEST)) (ITEST (PRINTOUT T "Not created yet" T)) (printout TTY "Illegal command. Redo" T))) (COND (Redo (GO LOOP)) (T (CLOSEW Iwind)))) (RETURN T]) (TestForever [LAMBDA (Count) (* sm: "15-Mar-85 16:37") (* does a repeated test/reset on the tester upto Count or 100 times) (* * loadOptions - T: Load LTFILES and stop. NIL - load LTFILES and then load StandardTestFiles and run them. varName - load LTFILES and then load files in varName and run them) (PROG ((SaveFlg LTDontAsk)) (SETQ LTDontAsk T) (LoadLTIfNeeded) (UNWINDPROTECT (PROGN (CNDIR (QUOTE {DSK})) (printout TTY "The tester will temporarily connect you to the local disk" T) (InteractiveLoopsTest) (for i from 1 to (OR Count 100) do (CleanupTester) (ResetLoopsTester) (InteractiveLoopsTest)) (CleanupTester)) (CNDIR) (SETQ LTDontAsk SaveFlg)) (RETURN "Done!!"]) (TestLoadedInstances [LAMBDA (self) (* sm: "21-SEP-83 11:51") (* used to test if file LTLOAD/LTDUMP loaded in properly) (PROG (U N (Ret T)) (COND ((%@ Checked) (RETURN T))) (←%@ Checked T) (SETQ U (%@ ULink)) [COND (U (COND [(EQ (GetValue self (QUOTE ULink) (QUOTE LinkVal)) (GetValue U (QUOTE Key))) (COND ((TestLoadedInstances U)) (T (SETQ Ret NIL) (GO OUT] (T (PrintIfLev LTMsgLev 4 (printout TTY "Instances not loaded properly from LTLOAD/LTDUMP" T "Check ULink from" self "to" U T)) (SETQ Ret NIL) (GO OUT] (SETQ N (%@ NLink)) [COND (N (COND [(EQ (GetValue self (QUOTE NLink) (QUOTE LinkVal)) (GetValue N (QUOTE Key))) (COND ((TestLoadedInstances N)) (T (SETQ Ret NIL) (GO OUT] (T (PrintIfLev LTMsgLev 4 (printout TTY "Instances not loaded properly from LTLOAD/LTDUMP" T "Check NLink from" self "to" N T)) (SETQ Ret NIL) (GO OUT] OUT (←%@ Checked NIL) (RETURN Ret]) ) (DECLARE: EVAL@COMPILE [PUTPROPS PrintIfLev MACRO (NLAMBDA (CLEV LEV EXP) (* executes EXP if LEV>=CLEV) (COND ((GEQ (EVAL LEV) (EVAL CLEV)) (EVAL EXP] ) (RPAQ? CoreTesterFiles (QUOTE (LTBASIC LTSUB LTKER LTCASES LTFILES))) (RPAQQ LTBASICVARS (CompiledTesterFiles (KBTestsFlg T) (LTBROWSER NIL) LTCompIntFlg LTDontAsk (LTInitW NIL) LTLOADEDREST LTLOGFLAG LTMsgLev LTError LTResult MainTesterFiles TempTesterFiles TesterTempObjects)) (RPAQQ CompiledTesterFiles (LTBASIC LTSUB LTKER LTCASES LTFILES LTCORETESTS LTLISPFUNTESTS LTMETHODTESTS LTKBTESTS LTPUTMETHODTEST LTLOAD LTBCLS)) (RPAQQ KBTestsFlg T) (RPAQQ LTBROWSER NIL) (RPAQQ LTCompIntFlg NIL) (RPAQQ LTDontAsk NIL) (RPAQQ LTInitW NIL) (RPAQQ LTLOADEDREST NIL) (RPAQQ LTLOGFLAG T) (RPAQQ LTMsgLev 8) (RPAQQ LTError NIL) (RPAQQ LTResult T) (RPAQQ MainTesterFiles (LTBASIC LTSUB LTKER LTCASES LTFILES LTCORETESTS LTLISPFUNTESTS LTMETHODTESTS LTKBTESTS LTPUTMETHODTEST LTHARMONYONLYTESTS LT1.KB LTLOAD LTBCLS)) (RPAQQ TempTesterFiles (LTDUMPC LTDUMPC.DCOM LTDUMP LTKBS1.KB LTKB1.KB LTKB2.KB LTKB3.KB LTKB4.KB LTKB5.KB LTKB7.KB LTKB10.KB)) (RPAQQ TesterTempObjects (LTCA5 LTDC21 LTNClass)) (RPAQQ BrkErrorFlg NIL) (FILESLOAD (SYSLOAD FROM LISPUSERS) TMENU) (ResetLTBASICVARS) (SETQ CurrentEnvironment NIL) (SetUpLoopsTest) (COND ((NULL (GetClassRec (QUOTE KB))) (SETQ KBTestsFlg NIL))) (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA MenuEval) (ADDTOVAR NLAML ) (ADDTOVAR LAMA ) ) (PUTPROPS LTBASIC COPYRIGHT ("Xerox Corporation" 1984 1985 1986)) (DECLARE: DONTCOPY (FILEMAP (NIL (5497 8130 (FailedTestBrowser.LeftShiftSelect 5507 . 5800) (TestBrowser.BoxNode 5802 . 6041) (TestBrowser.FlashNode 6043 . 6286) (TestBrowser.FlipNode 6288 . 6530) (TestBrowser.GetSubs 6532 . 7128) (TestBrowser.LeftShiftSelect 7130 . 7425) (TestBrowser.MiddleShiftSelect 7427 . 7716) ( TestBrowser.Recompute 7718 . 8128)) (8131 21537 (CopyTester 8141 . 9246) (EditATest 9248 . 9523) ( LTCompInt 9525 . 10084) (LoadLTIfNeeded 10086 . 10266) (LoadLTSystem 10268 . 10919) (LoadLTSystemCI 10921 . 11250) (LoadNeededFiles 11252 . 11791) (MakeTester 11793 . 12949) (MenuEval 12951 . 13275) ( ResetLTBASICVARS 13277 . 13625) (ResetFailedTests 13627 . 14280) (ResetLoopsTester 14282 . 15316) ( SetUpTestBrowser 15318 . 15662) (SetUpLoopsTest 15664 . 17494) (SetupLoopsTest2 17496 . 19206) ( TestForever 19208 . 20247) (TestLoadedInstances 20249 . 21535))))) STOP