(FILECREATED "21-SEP-83 11:55:43" {INDIGO}<LOOPS>SOURCES>LTBASIC.;3 27917
changes to: (FNS TestLoadedInstances BasicTest CopyTester DoTest MakeTester SetupLoopsTest2
TestForever)
previous date: "20-SEP-83 16:49:12" {IVY}<MITTAL>LISP>LTBASIC.;51)
(PRETTYCOMPRINT LTBASICCOMS)
(RPAQQ LTBASICCOMS [(CLASSES * LTBASICCLASSES)
(FNS * LTBASICFNS)
(MACROS PrintIfLev)
(VARS * LTBASICVARS)
(P (ResetLTBASICVARS)
(SetUpLoopsTest))
(DECLARE: DONTEVAL%@LOAD DOEVAL%@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA MenuEval)
(NLAML DoTest)
(LAMA])
(RPAQQ LTBASICCLASSES (AllTestBrowser SubTestBrowser TestBrowser FailedTestBrowser LTClass))
(DEFCLASSES AllTestBrowser SubTestBrowser TestBrowser FailedTestBrowser LTClass)
[DEFCLASS AllTestBrowser
(MetaClass Class Edited: (* sm: "30-MAR-83 11:07"))
(Supers TestBrowser)
(ClassVariables)
(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)))
(Methods)]
[DEFCLASS SubTestBrowser
(MetaClass Class Edited: (* sm: "29-MAR-83 14:51"))
(Supers TestBrowser)
(ClassVariables)
(InstanceVariables (title "SubTest Browser: Tests and their subtests")
(window ? DefRegion (426 540 598 150))
(subLinks (SubTest)))
(Methods)]
[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)
))
(Methods (BoxNode TestBrowser.BoxNode args (obj))
(FlashNode TestBrowser.FlashNode args (node N flashTime))
(FlipNode TestBrowser.FlipNode args (obj))
(GetSubs TestBrowser.GetSubs args (elt)
doc
(* 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)
)
(LeftShiftSelect TestBrowser.LeftShiftSelect args (obj objName)
doc (* action to be performed for LeftShift selection)
)
(MiddleShiftSelect TestBrowser.MiddleShiftSelect args (obj objName)
doc (* action for MiddleShift selection)
)
(Recompute TestBrowser.Recompute args NIL doc (* inherits Recompute from Super and does
TickleBrowserNodes)))]
[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)))
(Methods (LeftShiftSelect FailedTestBrowser.LeftShiftSelect args (obj objName)
doc (* action for LeftShift selection)
))]
[DEFCLASS LTClass
(MetaClass Class Edited: (* sm: "27-OCT-82 13:59"))
(Supers NamedObject)
(ClassVariables (GCV1 V1)
(PCV1 V1))
(InstanceVariables (GV1 V1)
(GV2 #(V2 NIL NIL))
(GV3 Class doc (* used for inheritance test))
(PV1 PV1))
(Methods)]
(RPAQQ LTBASICFNS (BasicTest CleanupTester CopyTester DoTest EditATest
FailedTestBrowser.LeftShiftSelect InteractiveLoopsTest LTCompInt
LTLoadFile LoadLTIfNeeded LoadLTSystem LoadLTSystemCI MakeTester
MenuEval ResetLTBASICVARS ResetFailedTests ResetLoopsTester
SetUpTestBrowser SetUpLoopsTest SetupLoopsTest2 TestBrowser.BoxNode
TestBrowser.FlashNode TestBrowser.FlipNode TestBrowser.LeftShiftSelect
TestBrowser.MiddleShiftSelect TestBrowser.Recompute TestForever
TestBrowser.GetSubs TestLoadedInstances))
(DEFINEQ
(BasicTest
[LAMBDA NIL (* sm: "20-SEP-83 16:35")
(* tests the kernel features of LOOPS)
(PROG (Temp OKList LTInst2)
(AND LTLOGFLAG (DRIBBLE (QUOTE LTLOG1)))
(SETQ LTError NIL)
(SETQ LTResult T)
(DoTest T (EQUAL (GetValue (%$ LTClass)
(QUOTE GV1))
(QUOTE V1))
"" "Get Value in class")
(DoTest (SETQ LTInst (SEND (%$ LTClass)
New))
(type? instance LTInst)
"Sending message and using New method to create instance" "Creation of instance")
(DoTest (AND CurrentEnvironment (SEND CurrentEnvironment MakeNotCurrent))
(NULL CurrentEnvironment)
"Making CurrentEnvironment be not current"
"CurrentEnvironment is Global(i.e. set to NIL)")
(DoTest T (EQ (Class LTInst)
(%$ LTClass))
"" "Checking Class of instance")
(DoTest T (EQUAL (GetValue LTInst (QUOTE GV1))
(QUOTE V1))
"" "GetValue inherits in instance")
(DoTest (PutValue (%$ LTClass)
(QUOTE PV1)
(QUOTE LTClass))
(EQUAL (GetValue (%$ LTClass)
(QUOTE PV1))
(QUOTE LTClass))
"PutValue in class" "PutValue in class")
(DoTest (PutValue LTInst (QUOTE GV3)
(QUOTE Inst))
(EQUAL (GetValue LTInst (QUOTE GV3))
(QUOTE Inst))
"PutValue in instance" "GetValue locally in instance")
(DoTest T (EQUAL (GetValue LTInst (QUOTE GV2))
(QUOTE V2))
"" "GetValue from active value")
(DoTest T (EQUAL (GetClassValue (%$ LTClass)
(QUOTE GCV1))
(QUOTE V1))
"" "GetClassValue in class")
(DoTest (LTLoadFile (QUOTE LTBCLS))
(AND (GetObjectRec (QUOTE LTClass1))
(GetObjectRec (QUOTE LTClass3))
(type? class (%$ LTClass2))
(type? class (%$ LTClass3)))
"Load classes from file" "Classes loaded properly")
(DoTest (SETQ LTInst2 (← (%$ LTClass2)
New))
(EQUAL (← LTInst2 BasicSS1)
21)
"" "←Super: Directly Invoked")
(DoTest (SETQ LTInst2 (← (%$ LTClass3)
New))
(EQUAL (← LTInst2 BasicSS1)
21)
"" "←Super: Invoked from Super class")
(DoTest (LTLoadFile (QUOTE LTLOAD))
(AND (TestLoadedInstances (%$ LD4))
(TestLoadedInstances (%$ LD1)))
"Load instances from file" "Instances loaded properly")
(printout TTY "Following features tested OK" T)
[for x in (DREVERSE OKList) do (COND
((EQUAL x ""))
(T (printout TTY x T]
(AND LTLOGFLAG (DRIBBLE NIL)) (* (LISTFILES LTLOG))
(RETURN LTInst])
(CleanupTester
[LAMBDA NIL (* dgb: " 2-MAR-83 16:17")
(* cleansUp by deleting temporary files etc after a
Tester run)
(PROG NIL
(COND
(CurrentEnvironment (← CurrentEnvironment Cancel)))
(← (%$ KB)
Close)
(SETQ NOTLISTEDFILES (DREMOVE (QUOTE LTDUMP)
NOTLISTEDFILES))
(SETQ NOTCOMPILEDFILES (DREMOVE (QUOTE LTDUMP)
NOTCOMPILEDFILES))
(DREMOVE (QUOTE LTDUMP)
FILELST)
(for f in MainTesterFiles do (DREMOVE f FILELST))
(for x in TempTesterFiles do (DELFILE x))
(for x in TesterTempObjects do (AND (GetObjectRec x)
(← (GetObjectRec x)
Destroy)))
(RETURN T])
(CopyTester
[LAMBDA (ToDir FromDir) (* sm: "20-SEP-83 16:41")
(* 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 {IVY}<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])
(DoTest
[NLAMBDA (Setup Test Msg1 Msg2) (* sm: "20-SEP-83 16:36")
(* Executes Setup, followed by Test.
If error, sets LTError to T. If Test fails
(NIL), sets LTResult to NIL)
(PROG (Res)
(SETQ Res (ERRORSET Setup T))
(COND
((NULL Res)
(SETQ LTError T)
(printout TTY "Error in setup" -3 Msg1 T "Code:" .PPF Setup T)
(printout TTY "Not testing" -3 Msg2 T)
(RETURN NIL)))
(SETQ OKList (CONS Msg1 OKList))
(SETQ Res (ERRORSET Test T))
(COND
((NULL Res)
(SETQ LTError T)
(printout TTY "Error in test" -3 Msg2 T "Code:" .PPF Test T)
(RETURN NIL))
((NULL (CAR Res))
(SETQ LTResult NIL)
(printout TTY "Bug: in" -3 Msg2 T "Code:" -3 .PPF Test T)
(RETURN NIL)))
(SETQ OKList (CONS Msg2 OKList))
(RETURN T])
(EditATest
[LAMBDA NIL (* sm: " 1-JUN-83 11:10")
(PROG NIL
(LoadLTIfNeeded)
(EVAL.IN.TTY.PROCESS (LIST (QUOTE SEND)
(GetObjectRec (PromptRead "ObjName:"))
(QUOTE EditTEST])
(FailedTestBrowser.LeftShiftSelect
[LAMBDA (self obj objName) (* sm: "25-NOV-82 15:46")
(* action for LeftShift selection)
(← obj ReTest])
(InteractiveLoopsTest
[LAMBDA (DontAsk) (* sm: " 1-MAR-83 15:03")
(* sets up the TestBrowser and offers to run all tests)
(* If DontAsk is non-nil it will run the tests)
(PROG (Seed Res)
(SetUpTestBrowser)
[SETQ Res (OR DontAsk LTDontAsk (ASKUSER 20 (QUOTE Y)
"Should I proceed with testing the system? "
(QUOTE ((Y "es
" RETURN T)
(N "o
" RETURN NIL)))
NIL NIL (QUOTE (CONFIRMFLG NIL]
(COND
(Res (BasicTest)
(BeginLoopsTest)))
(RETURN LTBROWSER])
(LTCompInt
[LAMBDA NIL (* sm: "31-MAY-83 10:27")
(* asks whether you want to run the tester compiled or
interpreted)
(PROG (res)
(SETQ res (INTTY "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])
(LTLoadFile
[LAMBDA (file) (* sm: "31-MAY-83 09:51")
(* loads file. If LTCompIntFlg is T, then source, else
compiled version)
(LOAD (COND
(LTCompIntFlg file)
(T (MKNAME (CONCAT file ".DCOM"])
(LoadLTIfNeeded
[LAMBDA NIL (* sm: "31-MAY-83 10:10")
(COND
((NOT LTLOADEDREST)
(LoadLTSystem LTCompIntFlg])
(LoadLTSystem
[LAMBDA (compIntFlg) (* sm: "31-MAY-83 09:49")
(* load rest of TestLOOPS system)
(* If compIntFlg is T loads source versions, else
compiled)
(PROG (saveFlg)
(SETQ saveFlg LTCompIntFlg)
(SETQ LTCompIntFlg compIntFlg)
(LTLoadFile (QUOTE LTKER))
(LTLoadFile (QUOTE LTDB))
(LTLoadFile (QUOTE LTCASES))
(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])
(MakeTester
[LAMBDA (ToDir FromDir) (* sm: "20-SEP-83 16:41")
(* 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 {IVY}<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: " 1-JUN-83 12:06")
(* 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" "
")
("Quit" (QUOTE (CLOSEW LTInitW))
"quit from testing mode" "
")
("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" " ")
("Make Tester" (QUOTE (MakeTester))
"Copies tester files by making and compiling them to {indigo}<kbvlsi>loops>sources>"
" ")
("Copy Tester" (QUOTE (CopyTester))
"Copies tester files to {indigo}<kbvlsi>loops>sources>"
" ")))
"LoopsTest Cmds"
(QUOTE (275 212 140 220]
(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])
(TestBrowser.BoxNode
[LAMBDA (self obj) (* sm: "10-DEC-82 17:35")
(COND
((← self HasObject obj)
(←Super
self BoxNode obj))
(T NIL])
(TestBrowser.FlashNode
[LAMBDA (self node N flashTime) (* sm: "25-NOV-82 15:17")
(COND
((← self HasObject node)
(←Super
self FlashNode node N flashTime])
(TestBrowser.FlipNode
[LAMBDA (self obj) (* sm: "25-NOV-82 15:19")
(COND
((← self HasObject obj)
(←Super
self FlipNode obj))
(T NIL])
(TestBrowser.LeftShiftSelect
[LAMBDA (self obj objName) (* sm: "25-NOV-82 15:44")
(* action to be performed for LeftShift selection)
(← obj TEST])
(TestBrowser.MiddleShiftSelect
[LAMBDA (self obj objName) (* sm: "25-NOV-82 15:45")
(* action for MiddleShift selection)
(← obj EditTEST])
(TestBrowser.Recompute
[LAMBDA (self) (* sm: "12-NOV-82 14:26")
(* inherits Recompute from Super and does
TickleBrowserNodes)
(←Super
self Recompute)
(TickleBrowserNodes (GetValue self (QUOTE startingList))
self])
(TestForever
[LAMBDA (Count) (* sm: "20-SEP-83 16:37")
(* does a repeated test/reset on the tester upto Count
or 100 times)
(PROG ((SaveFlg LTDontAsk))
(SETQ LTDontAsk T)
(LoadLTIfNeeded)
(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)
(printout TTY "Make sure you are connected to the desired directory" T)
(SETQ LTDontAsk SaveFlg)
(RETURN "Done!!"])
(TestBrowser.GetSubs
[LAMBDA (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])
(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])
)
(RPAQQ LTBASICVARS (CompiledTesterFiles LTBROWSER LTCompIntFlg LTDontAsk LTInitW LTLOADEDREST
LTLOGFLAG LTMsgLev LTError LTResult MainTesterFiles
TempTesterFiles TesterTempObjects))
(RPAQQ CompiledTesterFiles (LTBASIC LTKER LTCASES LTDB LTLOAD LTBCLS))
(RPAQQ LTBROWSER NIL)
(RPAQQ LTCompIntFlg NIL)
(RPAQQ LTDontAsk NIL)
(RPAQQ LTInitW {WINDOW}#13,71454)
(RPAQQ LTLOADEDREST NIL)
(RPAQQ LTLOGFLAG T)
(RPAQQ LTMsgLev 8)
(RPAQQ LTError NIL)
(RPAQQ LTResult T)
(RPAQQ MainTesterFiles (LTBASIC LTKER LTCASES LTDB 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))
(ResetLTBASICVARS)
(SetUpLoopsTest)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA MenuEval)
(ADDTOVAR NLAML DoTest)
(ADDTOVAR LAMA )
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (6059 26709 (BasicTest 6069 . 8868) (CleanupTester 8870 . 9737) (CopyTester 9739 . 10785
) (DoTest 10787 . 11793) (EditATest 11795 . 12070) (FailedTestBrowser.LeftShiftSelect 12072 . 12321) (
InteractiveLoopsTest 12323 . 13049) (LTCompInt 13051 . 13607) (LTLoadFile 13609 . 13950) (
LoadLTIfNeeded 13952 . 14132) (LoadLTSystem 14134 . 14777) (LoadLTSystemCI 14779 . 15108) (MakeTester
15110 . 16191) (MenuEval 16193 . 16517) (ResetLTBASICVARS 16519 . 16867) (ResetFailedTests 16869 .
17522) (ResetLoopsTester 17524 . 18558) (SetUpTestBrowser 18560 . 18904) (SetUpLoopsTest 18906 . 20834
) (SetupLoopsTest2 20836 . 22546) (TestBrowser.BoxNode 22548 . 22749) (TestBrowser.FlashNode 22751 .
22955) (TestBrowser.FlipNode 22957 . 23160) (TestBrowser.LeftShiftSelect 23162 . 23419) (
TestBrowser.MiddleShiftSelect 23421 . 23670) (TestBrowser.Recompute 23672 . 24038) (TestForever 24040
. 24890) (TestBrowser.GetSubs 24892 . 25419) (TestLoadedInstances 25421 . 26707)))))
STOP