(FILECREATED "21-SEP-83 11:39:10" {INDIGO}<LOOPS>SOURCES>LTKER.;2 116646 

      changes to:  (CLASSES LOOPSTestEnvironment LOOPSTestMethod LOOPSTestPrimitive)
		   (FNS AskPreTest AskSubTest AskSyntaxTest AskTestCases BeginLoopsTest 
			CheckClassTest CheckPreTest DescribePreviousTry DescribeTestLink DoLoopsTest 
			DoTestSelf EditPreTest EvaluateTest ExecTestFields LOOPSTestObject.DefineTEST 
			LOOPSTestObject.Describe LOOPSTestObject.EditTEST LOOPSTestObject.TEST 
			LOOPSTestObject.TEST! LOOPSTestObject.TestSelf LOOPSTestPrimitive.XTEST 
			LOOPSTestMeta.BeginLOOPSTest LOOPSTestKernel.TEST LOOPSTestObject.ReTest 
			LOOPSTestObject.ResetSelf MakeBackLink PerformAltTest PerformSetup 
			PerformTest PreTestsSatisfied? PrintFailedExp PrintTestCode PrintTestHeader)

      previous date: "20-SEP-83 16:42:59" {IVY}<MITTAL>LISP>LTKER.;125)


(PRETTYCOMPRINT LTKERCOMS)

(RPAQQ LTKERCOMS ((E (ResetLTKERVARS))
		  (CLASSES * LTKERCLASSES)
		  (FNS * LTKERFNS)
		  (INSTANCES * LTKERINSTANCES)
		  (MACROS * LTKERMACROS)
		  (VARS * LTKERVARS)
		  (P (ResetLTKERCLASSES))))

(RPAQQ LTKERCLASSES (LOOPSClassSuper LOOPSTestBasic LOOPSTestBraidObject LOOPSTestEnvironment 
				     LOOPSTestKernel LOOPSTestLispFunc LOOPSTestMeta LOOPSTestMethod 
				     LOOPSTestObject LOOPSTestPrimitive LOOPSTestSyntax))
(DEFCLASSES LOOPSClassSuper LOOPSTestBasic LOOPSTestBraidObject LOOPSTestEnvironment LOOPSTestKernel 
	    LOOPSTestLispFunc LOOPSTestMeta LOOPSTestMethod LOOPSTestObject LOOPSTestPrimitive 
	    LOOPSTestSyntax)
[DEFCLASS LOOPSClassSuper
   (MetaClass LOOPSTestMeta Edited:                          (* sm: "19-OCT-82 12:12"))
   (Supers NamedObject)
   (ClassVariables (InstanceComsVar LTKERINSTANCES))
   (InstanceVariables)
   (Methods (Destroy LOOPSClassSuper.Destroy args ? doc      (* destroys an instance; updates Instancecoms var and CV
							     Instances))
	    (GetTestCode LOOPSClassSuper.GetTestCode args NIL doc 
                                                             (* returns NIL, as there is currently no Test Code here)
			 ))]

[DEFCLASS LOOPSTestBasic
   (MetaClass LOOPSTestMeta Edited:                          (* sm: " 8-OCT-82 10:15")
	      doc                                            (* class for Test objects which are by themselves and 
							     not share PreTest dependencies)
	      )
   (Supers LOOPSTestObject)
   (ClassVariables (InstancePrefix LT)
		   (Instances (LTTemplate LTDumpInstance LTLoadInstance LTMethod LTObject 
					  LTActiveValue)
			      doc                            (* list of NAMES of objects which are instances of this 
							     class)
			      ))
   (InstanceVariables)
   (Methods)]

[DEFCLASS LOOPSTestBraidObject
   (MetaClass LOOPSTestMeta Edited:                          (* sm: " 5-OCT-82 12:46")
	      doc                                            (* instances are objects for testing LOOPS's built-in 
							     classes)
	      )
   (Supers LOOPSTestObject)
   (ClassVariables (InstancePrefix LTB)
		   (Instances NIL doc                        (* list of objects which are instances of this class)
			      ))
   (InstanceVariables)
   (Methods)]

[DEFCLASS LOOPSTestEnvironment
   (MetaClass LOOPSTestMeta Edited:                          (* sm: "29-MAR-83 15:24")
	      doc                                            (* used for testing KB and environments)
	      )
   (Supers LOOPSTestObject)
   (ClassVariables (InstancePrefix LTE)
		   (ClassPreTest #((LTMethod)
				   NIL AllowRemove))
		   (ClassTested? U)
		   (UnnamedInstanceCount 0)
		   (Instances (LTEMapObjectNames LTECancel LTEMakeCurrent LTEThawKB LTEFreezeKB 
						 LTEAssocKB LTEDumpToKB LTESummarize LTEDelete 
						 LTECommunity LTEOld LTENew)))
   (InstanceVariables (AfterTest NIL))
   (Methods)]

[DEFCLASS LOOPSTestKernel
   (MetaClass LOOPSTestMeta Edited:                          (* sm: "11-OCT-82 15:47")
	      doc                                            (* instances are for testing Kernel features.
							     currently only LTKernel is needed)
	      )
   (Supers LOOPSTestObject)
   (ClassVariables (Instances (LTKernel))
		   (KernelFeatures (LTFSend LTFGetValue LTFPutValue)
				   doc                       (* list of features which are part of Kernel Test)
				   )
		   (ClassPreTest #(NIL NIL AllowRemove)))
   (InstanceVariables)
   (Methods (TEST LOOPSTestKernel.TEST args NIL doc          (* TESTS THE KERNEL FEATURES OF LOOPS)))]

[DEFCLASS LOOPSTestLispFunc
   (MetaClass LOOPSTestMeta Edited:                          (* sm: " 5-OCT-82 16:36")
	      doc                                            (* instances are Test objects for LOOPS's Lisp 
							     functions)
	      )
   (Supers LOOPSTestObject)
   (ClassVariables (InstancePrefix LTF)
		   (Instances (LTFSendSuper LTFGetInitialValue LTFPutNthValue LTFGetNthValue 
					    LTFGetObjectNames LTFtype? LTFClass LTFGetObjectRec 
					    LTFReplaceActiveValue LTFPutLocalState LTFGetLocalState 
					    LTFRenameMethodFunction LTFMoveMethod LTFMoveVariable 
					    LTFMoveClassVariable LTFRenameVariable LTFCalledFns 
					    LTFRenameMethod LTFTryMethod LTFDoMethod LTFPutItOnly 
					    LTFGetItOnly LTFPutIt LTFGetIt LTFPutMethodOnly 
					    LTFGetMethodOnly LTFPutMethod LTFGetMethod 
					    LTFPutClassOnly LTFGetClassOnly LTFPutClass LTFGetClass 
					    LTFPutClassValueOnly LTFPutValueOnly LTFPushClassValue 
					    LTFPutClassValue LTFAddValue LTFPushValue 
					    LTFGetClassValueOnly LTFGetValueOnly LTFGetClassValue 
					    LTFDM LTFDC LTFPutValue LTFGetValue LTFSend)
			      doc                            (* list of objects which are instances of this class)
			      ))
   (InstanceVariables (LispName ? doc                        (* Lisp function name corresp to this object)
				))
   (Methods)]

[DEFCLASS LOOPSTestMeta
   (MetaClass MetaClass Edited:                              (* sm: "13-OCT-82 16:14"))
   (Supers Class)
   (ClassVariables (Instances NIL doc                        (* list of all instances of a LOOPSTest class)
			      )
		   (InstanceComsVar LTKERINSTANCES doc       (* variable used for saving instances on file.
							     should be changed if file is changed))
		   (UnnamedInstanceCount 0 doc               (* the counter used to generate new names of instances, 
							     if one is not given to NEW))
		   (InstancePrefix LTU doc                   (* prefix attached to names of instances for convenient 
							     identification)))
   (InstanceVariables)
   (Methods (BeginLOOPSTest LOOPSTestMeta.BeginLOOPSTest args NIL doc 
                                                             (* TESTS THE KERNEL FEATURES OF LOOPS))
	    (GetTestCode LOOPSTestMeta.GetTestCode args NIL doc 
                                                             (* returns NIL, as no TestCode yet))
	    (New LOOPSTestMeta.New args (name)
		 doc                                         (* inherits its Super's New and then adds the instance's
							     name to filecoms and CV Instances)
		 ))]

[DEFCLASS LOOPSTestMethod
   (MetaClass LOOPSTestMeta Edited:                          (* sm: "29-MAR-83 15:25")
	      doc                                            (* instances are for testing LOOPS's built-in methods)
	      )
   (Supers LOOPSTestObject)
   (ClassVariables (ClassPreTest #((LTMethod)
				   NIL AllowRemove))
		   (ClassTested? U)
		   (InstancePrefix LTM)
		   (UnnamedInstanceCount 0)
		   (Instances (LTMTitleCommandInObj LTMSetNameInObj LTMRenameInObj LTMPutInObj 
						    LTMPPV!InObj LTMPP!InObj LTMPPInObj LTMList!InObj 
						    LTMListInObj LTMInspectValueCommandInObj 
						    LTMInspectTitleMenuInObj LTMInspectTitleInObj 
						    LTMInspectStoreInObj LTMInspectPropertiesInObj 
						    LTMInspectPropCommandInObj LTMInspectFetchInObj 
						    LTMHasIVInObj LTMEditInObj LTMDumpFactsInObj 
						    LTMDestroy!InObj LTMDestroyInObj 
						    LTMTitleCommandInClass LTMSetNameInClass 
						    LTMRenameInClass LTMPutInClass LTMPPV!InClass 
						    LTMPP!InClass LTMPPInClass LTMList!InClass 
						    LTMInspectValueCommandInClass 
						    LTMInspectTitleMenuInClass LTMInspectTitleInClass 
						    LTMInspectStoreInClass 
						    LTMInspectPropertiesInClass 
						    LTMInspectPropCommandInClass 
						    LTMInspectFetchInClass LTMHasIVInClass 
						    LTMEditInClass LTMDumpFactsInClass 
						    LTMDestroy!InClass LTMDestroyInClass LTMWhereIs 
						    LTMUnderstands LTMUnSetName LTMTraceIt 
						    LTMReturnDefaultValue LTMPutIVProp LTMPrintOn 
						    LTMNoObjectForMsg LTMMessageNotUnderstood 
						    LTMInstantiate LTMInstOf! LTMInstOf LTMInspect 
						    LTMIVMissing LTMDoMethod LTMDeleteIV 
						    LTMCopyShallow LTMCopyDeep LTMClassName LTMClass 
						    LTMBreakIt LTMAt LTMAssocKB LTMAddIV 
						    LTMSubClasses LTMReplaceSupers LTMPPMethod LTMPPM 
						    LTMOnFile LTMNewWithValues LTMNewTemp LTMNew 
						    LTMMoveMethod LTMMethodDoc LTMInitialize LTMHasCV 
						    LTMFetchMethod LTMEditMethod LTMDisplaySubClasses 
						    LTMDefMethod LTMCopyMethod LTMCommentMethods 
						    LTMDeleteInClass LTMAdd LTMListInClass)
			      doc                            (* list of objects which are instances of this class)
			      ))
   (InstanceVariables)
   (Methods)]

[DEFCLASS LOOPSTestObject
   (MetaClass LOOPSTestMeta Edited:                          (* sm: "29-MAR-83 14:13")
	      doc                                            (* all testobjects which contain code for some test have
							     this on their supers chain)
	      )
   (Supers LOOPSClassSuper)
   (ClassVariables (ClassPreTest #(NIL NIL AllowRemove) Failed ? doc 
                                                             (* list of objects that need to be tested for a class of
							     test objects and are tried before an objects own 
							     PreTest))
		   (Instances NIL)
		   (InstancePrefix LTO)
		   (UnnamedInstanceCount 0)
		   (InstanceComsVar LTDBINSTANCES)
		   (ClassTested? ? doc                       (* set to T/NIL depending on ClassPreTest results)
				 )
		   (ResetList ((IV Tested? CompletelyTested? (PreTest Tested?)
				   (Tested? DoneOnce)
				   (SetUp Tested?)
				   (SyntaxTest Tested?)
				   (SubTest Tested?)
				   (AltTest Tested?)
				   (SetUp FailedExp)
				   (TestExpr FailedExpr)
				   (TestExpr HowFailed)
				   (PreTest Failed)
				   (SyntaxTest Failed)
				   (SubTest Failed)
				   (AltTest Failed))
			       (CV ClassTested? (ClassPreTest Failed)))
			      doc                            (* list of iv/cvs or their props which must be set to ? 
							     to begin a new test sequence)
			      ))
   (InstanceVariables (CasesUsed #(NIL NIL MakeBackLink) doc 
                                                             (* list of TestCases objects used)
				 BackLink UsedBy)
		      (PreTest #(NIL NIL MakeBackLink) BackLink PreTestOf doc 
                                                             (* list of objects that need to be tested before this 
							     one)
			       Tested? U Failed NIL)
		      (PreTestOf #(NIL NIL MakeBackLink) BackLink PreTest doc 
                                                             (* list of TestObjects which use this as PreTest)
				 )
		      (ResetExp NIL doc                      (* a lisp like expression used for undoing any state 
							     change introduced by a test))
		      (SetUp NIL Tested? #(U NIL FlashTestBrowser) FailedExp NIL doc 
                                                             (* a Lisp-like exp for setting up the test environment)
			     )
		      (TestExpr NIL FailedExp NIL HowFailed NIL doc 
                                                             (* this is the actual test expression))
		      (SyntaxTest #(NIL NIL MakeBackLink) BackLink SyntaxTestOf doc 
                                                             (* list of objects of type LOOPSTestSyntax for testing 
							     any special syntactic form associated with this object)
				  Tested? U Failed NIL)
		      (AltTest #(NIL NIL MakeBackLink) BackLink AltTestOf Tested? U Failed NIL doc 
                                                             (* list of TestObj which specify alternate ways of 
							     testing this concept))
		      (AltTestOf #(NIL NIL MakeBackLink) BackLink AltTest doc 
                                                             (* list of TestObj which use this for alternate ways of 
							     testing their concept))
		      (TestDesc "the feature indicated by the name" doc 
                                                             (* A brief description of what is being tested)
				)
		      (UsesObj #(NIL NIL AllowRemove) doc    (* list of objects used by this;
							     for ease of editing only -
							     no back links are kept))
		      (Tested? #(U NIL InformTestBrowser) DoneOnce NIL doc 
                                                             (* result of running the TestExpr))
		      (CompletelyTested? U Result NIL doc    (* result of all tests))
		      (StandBy #(NIL NIL AllowRemove) doc    (* list of objects which were once used but may not be 
							     in use anymore))
		      (SubTest #(NIL NIL MakeBackLink) BackLink SubTestOf Tested? U Failed NIL doc 
                                                             (* further things to Test if this tests OK)
			       )
		      (AfterTest NIL doc                     (* expression executed after TestExpr to do some 
							     resetting. Currently only used by LOOPSTestEnvironment 
							     and their subtests)))
   (Methods (DefineTEST LOOPSTestObject.DefineTEST args NIL doc 
                                                             (* used to define Test description for a TestObj.)
			)
	    (Describe LOOPSTestObject.Describe args NIL doc 
                                                             (* prints a description of the TestObj))
	    (EditTEST LOOPSTestObject.EditTEST args NIL doc 
                                                             (* edits a TestObj using menus))
	    (EditTestInTTYProcess LOOPSTestObject.EditTestInTTYProcess args NIL doc 
                                                             (* calls EditTEST in TTY Process))
	    (GetTestCode LOOPSTestObject.GetTestCode args NIL doc 
                                                             (* returns the Test Code fields))
	    (ReTest LOOPSTestObject.ReTest args (TestedLst)
		    doc                                      (* sends a ResetSelf if needed followed by TEST)
		    )
	    (ReTestDep LOOPSTestObject.ReTestDep args NIL doc 
                                                             (* first sends ResetDep and then TESTDep to self)
		       )
	    (Reset LOOPSTestObject.Reset args (AlreadyReset)
		   doc                                       (* resets the Tested type values so prior test results 
							     are wiped out. Also Resets PreTest and ClassPreTest)
		   )
	    (Reset! LOOPSTestObject.Reset! args (ResetLst)
		    doc                                      (* resets itself by sending Reset to self and also 
							     Reset! its SyntaxTest, AltTest and SubTest.
							     Also does a Reset on PreTest and ClassPreTest)
		    )
	    (ResetAll LOOPSTestObject.ResetAll args (ResetLst)
		      doc                                    (* completely resets itself, all tests on which it 
							     depends, and all which depend on it)
		      )
	    (ResetDep LOOPSTestObject.ResetDep args (ResetLst)
		      doc                                    (* resets itself and all tests which depend on it)
		      )
	    (ResetSelf LOOPSTestObject.ResetSelf args (AlreadyReset)
		       doc                                   (* resets the Tested type values so prior test results 
							     are wiped out.)
		       )
	    (TEST LOOPSTestObject.TEST args (TestedLst)
		  doc                                        (* performs the basic TEST for a TestObject)
		  )
	    (TEST! LOOPSTestObject.TEST! args (ContFl)
		   doc                                       (* first TESTs itself, and if successful, then does 
							     other tests- SubTest, SyntaxTest, AltTest.)
		   )
	    (TESTDep LOOPSTestObject.TESTDep args NIL doc    (* generates TEST call to self, and TESTDep to PreTestOf
							     list, and SubTest list only if it succeeds)
		     )
	    (TESTall LOOPSTestObject.TESTall args NIL doc    (* generates TEST call to self, PreTestOf list, and 
							     SubTest list))
	    (TestSelf LOOPSTestObject.TestSelf args (TestedLst)
		      doc                                    (* performs the basic TEST for a TestObject but 
							     continues even if PreTests fail)
		      ))]

[DEFCLASS LOOPSTestPrimitive
   (MetaClass LOOPSTestMeta Edited:                          (* sm: "30-MAR-83 10:59")
	      doc

          (* instances are for testing some primitive aspect of LOOPS not covered by other classes and pointed to USUALLY by
	  SubTest IV in other Test objects)


	      )
   (Supers LOOPSTestObject)
   (ClassVariables (InstancePrefix LTP)
		   (UnnamedInstanceCount 86)
		   (ClassPreTest #(NIL BuildPrimClassTest AllowRemove) comm 

          (* this active values always adds the IV SubTestOf to this list, so that the supers are always considered as 
	  PreTests for a Primitive TestObj)


				 Failed ?)
		   (Instances (LTP86 LTP85 LTP84 LTP83 LTP82 LTP81 LTP80 LTP79 LTP78 LTP77 LTP76 
				     LTP75 LTP74 LTP73 LTP72 LTP71 LTP70 LTP69 LTP68 LTP67 LTP66 
				     LTP65 LTP64 LTP63 LTP62 LTP61 LTP60 LTP59 LTP58 LTP57 LTP56 
				     LTP55 LAVPutValue LTP54 LTP53 LAVGetValue LTP52 LTP51 LTP50 
				     LTP49 LTP48 LTP47 LTP46 LTP45 LTP44 LTP43 LTP42 LTP41 LTP40 
				     LTP39 LTP38 LTP37 LTP36 LTP35 LTP34 LTP33 LTP32 LTP31 LTP30 
				     LTP29 LTP28 LTP27 LTP26 LTP25 LTP24 LTP23 LTP22 LTP21 LTP20 
				     LTP19 LTP18 LTP17 LTP16 LTP15 LTP14 LTP13 LTP12 LTP11 LTP10 LTP9 
				     LTP8 LTP7 LTP6 LTP5 LTP4 LTP3 LTP2 LTP1)
			      doc                            (* list of objects which are instances of this class)
			      ))
   (InstanceVariables (PreTest #(NIL BuildPreTest MakeBackLink) BackLink PreTestOf)
		      (SubTestOf #(NIL NIL MakeBackLink) BackLink SubTest doc 
                                                             (* back link to TestObj which uses this for a subtest)
				 ))
   (Methods (XTEST LOOPSTestPrimitive.XTEST args NIL doc     (* performs the basic TEST for a Primitive TestObject 
							     ONLYIF its super test Tested T and sets own Tested? IV)
		   ))]

[DEFCLASS LOOPSTestSyntax
   (MetaClass LOOPSTestMeta Edited:                          (* sm: "11-OCT-82 15:49")
	      doc                                            (* instances are for testing syntantic short forms in 
							     LOOPS. these instances are pointed to from SyntaxTest IV
							     in particular test objects)
	      )
   (Supers LOOPSTestObject)
   (ClassVariables (InstancePrefix LTS)
		   (Instances NIL doc                        (* list of objects which are instances of this class)
			      ))
   (InstanceVariables (SyntaxTestOf #(NIL NIL MakeBackLink) BackLink SyntaxTest doc 
                                                             (* list of TestObjs which use this for syntax test)
				    ))
   (Methods)]


(RPAQQ LTKERFNS (ATEST AddAltTest AllowRemove AskPreTest AskSubTest AskSyntaxTest AskTestCases 
		       BeginLoopsTest BuildPreTest BuildPrimClassTest CheckClassTest CheckPreTest 
		       CloseCurrentEnvironment CreateLTKBS1 DescribePreviousTry DescribeTestLink 
		       DisplayTestBrowser DoLoopsTest DoTestSelf EQACTVAL EditOtherLinksMenu 
		       EditPreTest EditTestOtherCmds EvaluateANDALLTest EvaluateANDTest 
		       EvaluatePROGTest EvaluateTest ExaminePreviousTry ExecTestFields FindObjForLink 
		       FlashTestBrowser GIVGetFn GenerateTestList GetFromActVal InformTestBrowser 
		       LOOPSTestEnvironment.TEST LOOPSTestObject.DefineTEST LOOPSTestObject.Describe 
		       LOOPSTestObject.EditTEST LOOPSTestObject.EditTestInTTYProcess 
		       LOOPSTestObject.GetTestCode LOOPSTestObject.TEST LOOPSTestObject.TEST! 
		       LOOPSTestObject.TESTDep LOOPSTestObject.TESTall LOOPSTestObject.TestSelf 
		       LOOPSTestPrimitive.XTEST LinkEditOtherMenu LOOPSTestMeta.BeginLOOPSTest 
		       LOOPSTestMeta.GetTestCode LOOPSTestMeta.New LOOPSTestKernel.TEST 
		       LOOPSClassSuper.Destroy LOOPSClassSuper.GetTestCode LOOPSTestObject.ReTest 
		       LOOPSTestObject.ReTestDep LOOPSTestObject.Reset LOOPSTestObject.Reset! 
		       LOOPSTestObject.ResetAll LOOPSTestObject.ResetDep LOOPSTestObject.ResetSelf 
		       MakeBackLink MakeSet ObjectName PerformAltTest PerformSetup PerformTest 
		       PreTestsSatisfied? PrintFailedExp PrintTestCode PrintTestHeader 
		       PushClassValueNew PutInActVal ReadLinkMenu ReasonNotDone RemoveValue 
		       ResetLTKERCLASSES ResetLTKERVARS ResetPutLocalStateVars RunTest 
		       SetupEditTestObjMenu TestErrorBreak TestObjectDesc TickleBrowserNodes))
(DEFINEQ

(ATEST
  [LAMBDA (Exp Comm)                                         (* sm: "30-NOV-82 16:17")
    Exp])

(AddAltTest
  [LAMBDA (self)                                             (* sm: "29-OCT-82 15:29")
                                                             (* offers to help add AltTest.
							     Returns T -
							     if any added. NIL -
							     otherwise)
                                                             (* currently a no op)
    (PROG NIL
          (RETURN NIL])

(AllowRemove
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "11-OCT-82 15:42")

          (* This is a putFn for allowing values to be removed by using the format (- v). Any other kind will be added as 
	  such)


    (COND
      ((ATOM newValue)
	(PutLocalState activeVal (CONS newValue (GetLocalState activeVal self varName propName))
		       self varName propName type))
      ((EQ (CAR newValue)
	   (QUOTE -))
	(PutLocalState activeVal (DREMOVE (CADR newValue)
					  (GetLocalState activeVal self varName propName))
		       self varName propName type))
      (T (PutLocalState activeVal newValue self varName propName type])

(AskPreTest
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:22")
                                                             (* ask for changes to PreTests)
    (PROG (PreTest)
          (SETQ PreTest (ASKUSER NIL NIL (LIST "Current PreTests are:" (@ PreTest)
					       "Do you want to add/delete any")
				 (QUOTE ((A "dd
" EXPLAINSTRING "Add - enter the ADDITIONS to PreTest list" KEYLST (( NIL RETURN ANSWER CONFIRMFLG T)
					     ))
					  (M "odify
" EXPLAINSTRING "Modify - enter the NEW PreTest list" KEYLST (((READ)
					       NIL RETURN ANSWER CONFIRMFLG T)))
					  (D "elete
" EXPLAINSTRING "Delete - enter the list of PreTests to be deleted" KEYLST
					     (((READ)
					       NIL RETURN ANSWER CONFIRMFLG T)))
					  (N "o
" EXPLAINSTRING "No - no change" RETURN NIL)))
				 NIL NIL (QUOTE (CONFIRMFLG NIL))
				 NIL))
          [COND
	    (PreTest (SELECTQ (CAR PreTest)
			      ((A Add)
				(for x in (MKLIST (CADR PreTest)) do (PutValue self (QUOTE PreTest)
									       x)))
			      ((M Modify)
				(for x in (@ PreTest) do (RemoveValue self (QUOTE PreTest)
								      x))
				(for y in (MKLIST (CADR PreTest)) do (PutValue self (QUOTE PreTest)
									       x)))
			      ((D Delete)
				(for x in (MKLIST (CADR PreTest)) do (RemoveValue self (QUOTE PreTest)
										  x)))
			      (printout TTY "Illegal format PreTest list. Ignoring.." PreTest T]
          (printout TTY "New PreTests are:" T (@ PreTest)
		    T])

(AskSubTest
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:22")
                                                             (* ask for changes to SubTest list)
    (PROG (PreTest)
          (SETQ PreTest (ASKUSER NIL NIL (LIST "Current SubTest objects are:" (@ SubTest)
					       "Do you want to add/delete any")
				 (QUOTE ((A "dd
" EXPLAINSTRING "Add - enter the ADDITIONS to SubTest list" KEYLST (((READ)
					      
				"a number of new Primitive or a list of existing SubTest objects"
					      RETURN ANSWER CONFIRMFLG T)))
					  (M "odify
" EXPLAINSTRING "Modify - enter the NEW SubTest list" KEYLST (((READ)
					       NIL RETURN ANSWER CONFIRMFLG T)))
					  (D "elete
" EXPLAINSTRING "Delete - enter the list of SubTests to be deleted" KEYLST
					     (((READ)
					       NIL RETURN ANSWER CONFIRMFLG T)))
					  (N "o
" EXPLAINSTRING "No - no change" RETURN NIL)))
				 NIL NIL (QUOTE (CONFIRMFLG NIL))
				 NIL))
          [COND
	    (PreTest (SELECTQ (CAR PreTest)
			      [(A Add)
				(COND
				  [(NUMBERP (CADR PreTest))
				    (RPTQ (CADR PreTest)
					  (PutValue self (QUOTE SubTest)
						    (GetValue (SEND ($ LOOPSTestPrimitive)
								    New)
							      (QUOTE name]
				  (T (for x in (MKLIST (CADR PreTest)) do (PutValue self
										    (QUOTE SubTest)
										    x]
			      ((M Modify)
				(for x in (@ SubTest) do (RemoveValue self (QUOTE SubTest)
								      x))
				(for y in (MKLIST (CADR PreTest)) do (PutValue self (QUOTE SubTest)
									       x)))
			      ((D Delete)
				(for x in (MKLIST (CADR PreTest)) do (RemoveValue self (QUOTE SubTest)
										  x)))
			      (printout TTY "Illegal format SubTest list. Ignoring.." PreTest T]
          (printout TTY "New SubTests are:" T (@ SubTest)
		    T])

(AskSyntaxTest
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:22")
                                                             (* ask for changes to Syntax test list)
    (PROG (PreTest)
          (SETQ PreTest (ASKUSER NIL NIL (LIST "Current SyntaxTest objects are:" (@ SyntaxTest)
					       "Do you want to add/delete any")
				 (QUOTE ((A "dd
" EXPLAINSTRING "Add - enter the ADDITIONS to SyntaxTest list" KEYLST (((READ)
					      
				       "a number of new or a list of existing SyntaxTest objects"
					      RETURN ANSWER CONFIRMFLG T)))
					  (M "odify
" EXPLAINSTRING "Modify - enter the NEW SyntaxTest list" KEYLST (((READ)
					       NIL RETURN ANSWER CONFIRMFLG T)))
					  (D "elete
" EXPLAINSTRING "Delete - enter the list of SyntaxTests to be deleted" KEYLST
					     (((READ)
					       NIL RETURN ANSWER CONFIRMFLG T)))
					  (N "o
" EXPLAINSTRING "No - no change" RETURN NIL)))
				 NIL NIL (QUOTE (CONFIRMFLG NIL))
				 NIL))
          [COND
	    (PreTest (SELECTQ (CAR PreTest)
			      [(A Add)
				(COND
				  [(NUMBERP (CADR PreTest))
				    (RPTQ (CADR PreTest)
					  (PutValue self (QUOTE SyntaxTest)
						    (GetValue (SEND ($ LOOPSTestSyntax)
								    New)
							      (QUOTE name]
				  (T (for x in (MKLIST (CADR PreTest)) do (PutValue self
										    (QUOTE SyntaxTest)
										    x]
			      ((M Modify)
				(for x in (@ SyntaxTest) do (RemoveValue self (QUOTE SyntaxTest)
									 x))
				(for y in (MKLIST (CADR PreTest)) do (PutValue self (QUOTE SyntaxTest)
									       x)))
			      ((D Delete)
				(for x in (MKLIST (CADR PreTest)) do (RemoveValue self (QUOTE 
										       SyntaxTest)
										  x)))
			      (printout TTY "Illegal format SyntaxTest list. Ignoring.." PreTest T]
          (printout TTY "New SyntaxTests are:" T (@ SyntaxTest)
		    T])

(AskTestCases
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:23")
                                                             (* ask for changes to TestCases list)
    (PROG (PreTest)
      TC  (SETQ PreTest (ASKUSER NIL NIL (LIST "Current TestCase objects are:" (@ CasesUsed)
					       "Do you want to add/delete any")
				 (QUOTE ((A "dd
" EXPLAINSTRING "Add - enter the number of new TestCase objects to be created" KEYLST
					    (((READ)
					      NIL RETURN ANSWER CONFIRMFLG T)))
					  (D "elete
" EXPLAINSTRING "Delete - enter the list of TestCases to be deleted" KEYLST
					     (((READ)
					       NIL RETURN ANSWER CONFIRMFLG T)))
					  (N "o
" EXPLAINSTRING "No - no change" RETURN NIL)))
				 NIL NIL (QUOTE (CONFIRMFLG NIL))
				 NIL))
          [COND
	    (PreTest (SELECTQ (CAR PreTest)
			      [(A Add)
				(COND
				  ((NOT (NUMBERP (CADR PreTest)))
				    (printout TTY "Specify a number. " T)
				    (GO TC)))
				(RPTQ (CADR PreTest)
				      (PutValue self (QUOTE CasesUsed)
						(GetValue (SEND ($ LOOPSTestCases)
								New)
							  (QUOTE name]
			      ((D Delete)
				(for x in (MKLIST (CADR PreTest)) do (RemoveValue self (QUOTE 
											CasesUsed)
										  x)))
			      (printout TTY "Illegal format CasesUsed list. Ignoring.." PreTest T]
          (printout TTY "New TestCases are:" T (@ CasesUsed)
		    T])

(BeginLoopsTest
  [LAMBDA NIL                                                (* sm: "20-SEP-83 16:23")
                                                             (* begins the test of rest of LOOPS after the basic 
							     tests succeeded)
    (PROG (Tlis Inp)

          (* Variables set: Seed -
	  list of initial testobjs;HasTest -
	  ones which have TestExpr; Tested -
	  ones actually tested; Failed -
	  those which failed; NotDone -
	  those not completed)


          [COND
	    ((OR LTError (NOT LTResult))
	      (SETQ INP (ASKUSER 60 (QUOTE Y)
				 "The basic tests failed. Do you still want to continue?"
				 (QUOTE ((Y "es
" CONFIRMFLG NIL)
					  (N "o
" CONFIRMFLG NIL)))
				 T))
	      (COND
		((EQ INP (QUOTE N))
		  (RETURN NIL]
          (AND LTLOGFLAG (DRIBBLE (QUOTE LTLOG2)))
          (SETQ Tlis (GenerateTestList))
          (SETQ Seed (CAR Tlis))
          (SETQ HasTest (CDR Tlis))
          (SETQ Tested (RunTest Seed))
          (SETQ Failed (for x in Tested when (NULL (GetValue x (QUOTE Tested?))) collect x))
          (SETQ NotDone (APPEND (LDIFFERENCE HasTest Tested)
				(for x in Tested when (UnknownValue? (GetValue x (QUOTE Tested?)))
				   collect x)))
          (printout TTY T T T 15 "Summary of LOOPS Test:" T T)
          [AND Failed (PROGN (printout TTY "Following failed:" T)
			     (for x in Failed do (printout TTY 10 (GetValue x (QUOTE TestDesc))
							   T]
          [AND NotDone (PROGN (printout TTY T "Following could not be run to completion:" 45 "Reason" 
					T)
			      (for x in NotDone do (printout TTY 5 (GetValue x (QUOTE TestDesc))
							     45
							     (ReasonNotDone x)
							     T]
          (COND
	    [(OR Failed NotDone)
	      (SETQ LTABROWSER (SETQ LTBROWSER (DisplayTestBrowser (APPEND Failed NotDone)
								   (QUOTE FailedTestBrowser)
								   NIL NIL NIL T]
	    (T (printout TTY "Congratulations!! You have a fully tested LOOPS System. Happy LOOPing" 
			 T)))
          (AND LTLOGFLAG (DRIBBLE NIL))
          (RETURN (NOT (OR Failed NotDone])

(BuildPreTest
  [LAMBDA (self varName localSt propName activeVal type)     (* sm: " 8-OCT-82 11:25")
                                                             (* This is a getFn for PreTest in LOOPSTestPrimitive)
                                                             (* it appends SubTestOf to the front of the local state 
							     and returns that as the actual PreTest list)

          (* ASSUMPTION: This now forces all SubTestOf objects to be considered as PreTests. If this assumption is later 
	  violated, this scheme of building PreTest list will have to be undone)


    (APPEND (%@ SubTestOf)
	    (GetLocalState activeVal self varName propName])

(BuildPrimClassTest
  [LAMBDA (self varName localSt propName activeVal type)     (* sm: " 8-OCT-82 10:56")
                                                             (* This is a getFn for ClassPreTest CV in 
							     LOOPSTestPrimitive)

          (* it adds the value of IV SubTestOf to any values already in the CV ClassPreTest to compute the actual 
	  ClassPreTest list. Normally, no separate values are planned for ClassPreTest. Currently, the main purpose of this 
	  active value is to return the SubTestOf list as the ClassPreTest)


    (APPEND (%@ SubTestOf)
	    (GetLocalState activeVal self varName propName])

(CheckClassTest
  [LAMBDA (self TestedLst)                                   (* sm: "20-SEP-83 16:24")
                                                             (* Checks the Class Pretests of a TestObj)
    (PROG (TestRes Mat)                                      (* check if class already tested)
          [COND
	    ((ValueExists? (@@ ClassTested?))
	      (RETURN (@@ ClassTested?]                      (* if class has no pretest, return T)
          (COND
	    ((NULL (@@ ClassPreTest))
	      (PrintIfLev LTMsgLev 5 (printout TTY 10 "SysNote: No class pretests for" -4
					       (@ name)
					       T))
	      (RETURN T)))
          [SETQ TestRes (MAPCAR (@@ ClassPreTest)
				(QUOTE (LAMBDA (x)
					       (CONS (SEND (GetObjectRec x)
							   TEST TestedLst)
						     x]
          (COND
	    ((SETQ Mat (FASSOC NIL TestRes))
	      (PutClassValue self (QUOTE ClassPreTest)
			     (CDR Mat)
			     (QUOTE Failed))
	      (←@@
		ClassTested? NIL))
	    ((SETQ Mat (FASSOC NotSetValue TestRes))
	      (PutClassValue self (QUOTE ClassPreTest)
			     (CDR Mat)
			     (QUOTE Failed))
	      (←@@
		ClassTested? NotSetValue))
	    (T (←@@
		 ClassTested? T)))
          (RETURN (@@ ClassTested?])

(CheckPreTest
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:24")
                                                             (* checks the PreTest of a TestObj)
    (PROG (TestRes)                                          (* see if already tested)
          [COND
	    ((ValueExists? (GetValue self (QUOTE PreTest)
				     (QUOTE Tested?)))
	      (RETURN (GetValue self (QUOTE PreTest)
				(QUOTE Tested?]
          (COND
	    ((NULL (@ PreTest))
	      (printout TTY 10 "SysNote: No PreTests for  " -4 (@ name)
			T)
	      (RETURN T)))
          [SETQ TestRes (MAPCAR (@ PreTest)
				(QUOTE (LAMBDA (X)
					       (SEND (GetObjectRec X)
						     TEST]
          [COND
	    ((FMEMB NIL TestRes)
	      (PutValue self (QUOTE PreTest)
			NIL
			(QUOTE Tested?)))
	    ((FMEMB NotSetValue TestRes)
	      (PutValue self (QUOTE PreTest)
			NotSetValue
			(QUOTE Tested?)))
	    (T (PutValue self (QUOTE PreTest)
			 T
			 (QUOTE Tested?]
          (RETURN (GetValue self (QUOTE PreTest)
			    (QUOTE Tested?])

(CloseCurrentEnvironment
  [LAMBDA NIL                                                (* sm: "23-NOV-82 14:22")
    (AND CurrentEnvironment (SEND CurrentEnvironment Close])

(CreateLTKBS1
  [LAMBDA NIL                                                (* sm: " 7-FEB-83 16:49")
                                                             (* creates the knowledge base LTKBS1 used by 
							     LTESummarize)
    (PROG NIL
          (← (%$ KB)
	     New
	     (QUOTE LTKBS1)
	     (QUOTE X1)
	     T)
          (← (%$ X1)
	     Open)
          (← (%$ LOOPSCasesMeta)
	     New
	     (QUOTE LOOPSEnvSumm)
	     (QUOTE (LOOPSTestCases)))
          (← (%$ LOOPSEnvSumm)
	     Add
	     (QUOTE CV)
	     (QUOTE Instances)
	     NIL)
          (← (%$ LOOPSEnvSumm)
	     Add
	     (QUOTE CV)
	     (QUOTE InstancePrefix)
	     (QUOTE LESA))
          (← (%$ LOOPSEnvSumm)
	     Add
	     (QUOTE CV)
	     (QUOTE UnnamedInstanceCount)
	     0)
          (← (%$ LOOPSEnvSumm)
	     Add
	     (QUOTE CV)
	     (QUOTE InstanceComsVar)
	     (QUOTE DUMMYINSTANCES))
          (← (%$ LOOPSEnvSumm)
	     Add
	     (QUOTE IV)
	     (QUOTE Etest)
	     NIL)
          (← (%$ LOOPSEnvSumm)
	     Add
	     (QUOTE IV)
	     (QUOTE Link)
	     NIL)
          (← (%$ LOOPSEnvSumm)
	     New
	     (QUOTE LESAA))
          (← (%$ LOOPSEnvSumm)
	     New)
          (PutValue (%$ LESAA)
		    (QUOTE Etest)
		    (QUOTE Old))
          (← (%$ Class)
	     New
	     (QUOTE LOOPSEnvTest))
          (← (%$ LOOPSEnvTest)
	     Add
	     (QUOTE IV)
	     (QUOTE Key)
	     NIL)
          (PutValue (%$ LESAA)
		    (QUOTE Link)
		    (← (%$ LOOPSEnvTest)
		       New))
          (PutValue (GetValue (%$ LESAA)
			      (QUOTE Link))
		    (QUOTE Key)
		    (QUOTE LESAA))
          [SETQ LTV11 (MKNAME (UID (GetValue (%$ LESAA)
					     (QUOTE Link]
          (← (%$ X1)
	     Cleanup)
          (← (%$ X1)
	     Close)
          (← (%$ KB)
	     Old
	     (QUOTE LTKBS1)
	     (QUOTE X2))
          (← (%$ X2)
	     Open)
          (PutValue (%$ LESAA)
		    (QUOTE Etest)
		    (QUOTE New))
          (← (%$ LOOPSEnvSumm)
	     New)
          (PutValue (%$ LESA2)
		    (QUOTE Etest)
		    (QUOTE LESA2))
          (← (%$ X2)
	     Close)
          (← (%$ KB)
	     Old
	     (QUOTE LTKBS1)
	     (QUOTE X3))
          (← (%$ X3)
	     Open)
          (← (%$ LESA1)
	     Destroy)
          (PutValue (%$ LESA2)
		    (QUOTE Link)
		    (← (%$ LOOPSEnvTest)
		       New))
          (PutValue (GetValue (%$ LESA2)
			      (QUOTE Link))
		    (QUOTE Key)
		    (QUOTE LESA2))
          [SETQ LTV12 (MKNAME (UID (GetValue (%$ LESA2)
					     (QUOTE Link]
          (PutValue (%$ LESAA)
		    (QUOTE Link)
		    NIL)
          (← (%$ X3)
	     Close)
          (RETURN (LIST (QUOTE (LOOPSEnvSumm LOOPSEnvTest))
			(QUOTE (LESAA LESA2))
			(QUOTE (LESA1))
			(LIST (QUOTE LTV11)
			      LTV11)
			(LIST (QUOTE LTV12)
			      LTV12])

(DescribePreviousTry
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:24")
                                                             (* describes result of previous test of this obj)
    (PROG NIL
          (RETURN (COND
		    ((ValueNonNIL? (ExaminePreviousTry self))
		      (printout TTY "Test was successful!!" T)
		      T)
		    ((AND (@@ ClassPreTest)
			  (NOT (EQ (@@ ClassTested?)
				   T)))
		      (printout TTY "Following PreTest for this Class of tests failed:" T
				(@@ self ClassPreTest Failed)
				T)
		      NIL)
		    ((AND (@ PreTest)
			  (NOT (EQ (@ self PreTest Tested?)
				   T)))
		      (printout TTY "Following PreTests failed:" (@ self PreTest Failed)
				T)
		      NIL)
		    ((AND (@ SetUp)
			  (NOT (EQ (@ self SetUp Tested?)
				   T)))
		      (printout TTY "Following SetUp expression(s) caused error:" T)
		      (PrintFailedExp self (@ self SetUp FailedExp))
		      NIL)
		    ((NULL (@ TestExpr))
		      (printout TTY "No test is available yet." T)
		      T)
		    (T (printout TTY "Following TestExpression(s) failed or caused error:" T)
		       (PrintFailedExp self (@ self TestExpr FailedExp))
		       NIL])

(DescribeTestLink
  [LAMBDA (self link Desc Selected)                          (* sm: "20-SEP-83 16:25")
                                                             (* describes the values of link, using a menu of 
							     description-choices)
    (PROG ((vals (GetValue self link))
	   obj)                                              (* Desc -
							     if NIL, user is asked for a value)
                                                             (* Selected -
							     if NIL user is asked.)
          (COND
	    ((NULL vals)
	      (RETURN NIL)))
          [COND
	    (Desc)
	    (T (SETQ Desc (MENU (create MENU
					ITEMS ←(QUOTE (TestDesc TestDescAll TestDescAsk TestCode PP))
					TITLE ← "Desc What"]
          (COND
	    ((NULL Desc)
	      (RETURN NIL)))
          [COND
	    (Selected)
	    (T (SETQ Selected (ReadLinkMenu self link T T]
          [for x in Selected do (PROGN (SETQ obj (GetObjectRec x))
				       (SELECTQ Desc
						(PP (SEND obj PP))
						(TestCode (PrintTestCode obj))
						(TestDesc (printout TTY (ObjectName obj)
								    -5
								    (TestObjectDesc obj)
								    T))
						(TestDescAll (printout TTY (ObjectName obj)
								       -5
								       (TestObjectDesc obj)
								       T)
							     (DescribeTestLink obj link (QUOTE 
										      TestDescAll)
									       (GetValue obj link)))
						(TestDescAsk (printout TTY (ObjectName obj)
								       -5
								       (TestObjectDesc obj)
								       T)
							     (DescribeTestLink obj link (QUOTE 
										      TestDescAsk)
									       NIL))
						(printout TTY 
					"Error!! Should not reach here in func: DescribeTestLink"
							  T]
          (RETURN Selected])

(DisplayTestBrowser
  [LAMBDA (Objs BrowserClass Link Region Title FlipFlg)      (* sm: " 3-DEC-82 09:55")

          (* displays a TestBrowser with "Objs", using "Link", in a window bounded by "Region" and "Title". All except the 
	  first arg can be defaulted to whats in the class (%$ TestBrowser))

                                                             (* FlipFlg -
							     if T then all objects which have Tested? IV set to T 
							     will be flipped)
                                                             (* binds global LTBROWSER to the browser created)
    (PROG NIL
          (COND
	    ((NULL Objs)
	      (RETURN NIL)))
          [COND
	    ((NULL BrowserClass)
	      (SETQ BrowserClass (QUOTE TestBrowser]
          (SETQ LTBROWSER (← (GetObjectRec BrowserClass)
			     New))
          [COND
	    (Link (PutValue LTBROWSER (QUOTE subLinks)
			    (MKLIST Link]
          (COND
	    (Title (PutValue LTBROWSER (QUOTE title)
			     Title)))
          [← LTBROWSER Show [SETQ Objs (MAPCAR Objs (QUOTE (LAMBDA (X)
								   (GetObjectRec X]
	     (CREATEW [COND
			(Region)
			(T (GetValue LTBROWSER (QUOTE window)
				     (QUOTE DefRegion]
		      (GetValue LTBROWSER (QUOTE title]
          (COND
	    (FlipFlg (TickleBrowserNodes Objs LTBROWSER)))
          (RETURN LTBROWSER])

(DoLoopsTest
  [LAMBDA (self testVar testMsg contFl TestedLst)            (* sm: "20-SEP-83 16:25")
                                                             (* tests the objs indicated by IV testVar, using msg 
							     testMsg, and force test flag contFl)
    (PROG (TestRes Mat)                                      (* set up default values if not passed)
          (COND
	    ((NULL testVar)
	      (printout TTY "No Test IV given." -2 "Aborting.." T)
	      (RETURN NIL)))
          [COND
	    ((NULL testMsg)
	      (SETQ testMsg (QUOTE TEST]                     (* see if already tested)
          [COND
	    ((ValueExists? (GetValue self testVar (QUOTE Tested?)))
	      (RETURN (GetValue self testVar (QUOTE Tested?]
          (COND
	    ((NULL (GetValue self testVar))
	      (PrintIfLev LTMsgLev 5 (printout TTY 10 "SysNote: No " testVar " for  " -4
					       (@ name)
					       T))
	      (PutValue self testVar T (QUOTE Tested?))
	      (RETURN T)))
          [SETQ TestRes (MAPCAR (GetValue self testVar)
				(QUOTE (LAMBDA (X)
					       (CONS (DoMethod (GetObjectRec X)
							       testMsg NIL TestedLst contFl)
						     X]
          [COND
	    ((SETQ Mat (FASSOC NIL TestRes))
	      (PutValue self testVar (CDR Mat)
			(QUOTE Failed))
	      (PutValue self testVar NIL (QUOTE Tested?)))
	    ((SETQ Mat (FASSOC NotSetValue TestRes))
	      (PutValue self testVar (CDR Mat)
			(QUOTE Failed))
	      (PutValue self testVar NotSetValue (QUOTE Tested?)))
	    (T (PutValue self testVar T (QUOTE Tested?]
          (RETURN (GetValue self testVar (QUOTE Tested?])

(DoTestSelf
  [LAMBDA (self TestedLst)                                   (* sm: "20-SEP-83 16:25")
                                                             (* executes the SetUp, TestExpr, and AfterTest of a Test
							     Object)
    (PROG (TestExp)
          (PrintTestHeader self)
          (SETQ TestExp (@ TestExpr))
          [COND
	    ((NULL TestExp)
	      (printout TTY 5 "No test is currently available for.." -3 (@ TestDesc)
			T)
	      (←@
		Tested?
		(COND
		  (LTAskNoTestAvailable (ASKUSER 15 (QUOTE Y)
						 (QUOTE ("Indicate if this feature works OK"))
						 (QUOTE ((Y "es
" RETURN T EXPLAINSTRING "Yes- the test for this is marked as successful")
							  (N "o
" RETURN NIL EXPLAINSTRING "No- the test for this is marked as Unsuccessful")
							  (U "nknown
" RETURN NotSetValue EXPLAINSTRING "Unknown- the test for this is marked as incomplete")))
						 NIL NIL (QUOTE (CONFIRMFLG NIL))
						 NIL))
		  (T (printout TTY "Assuming it is OK" T)
		     T)))
	      (RETURN (@ Tested?]
          [COND
	    ((NOT (EQ (PerformSetup self)
		      T))
	      (AND LTBROWSER (SEND LTBROWSER BoxNode self))
	      (RETURN (PerformAltTest self (QUOTE SetUp)
				      NIL TestedLst]
          (PerformTest self)
          (COND
	    ((ValueExists? (@ self SetUp Tested?))
	      (ERRORSET (GetValue self (QUOTE AfterTest))
			T)))
          (AND LTBROWSER (SEND LTBROWSER BoxNode self))
          (RETURN (@ Tested?])

(EQACTVAL
  [LAMBDA (ActVal Flist)                                     (* sm: "29-NOV-82 17:08")
                                                             (* checks if ActVal is an active value and has fields as
							     given by Flist)
                                                             (* currently works only for singly nested active value)
    (AND (EQ (CAR Flist)
	     (fetch localState of ActVal))
	 (EQ (CADR Flist)
	     (fetch getFn of ActVal))
	 (EQ (CADDR Flist)
	     (fetch putFn of ActVal])

(EditOtherLinksMenu
  [LAMBDA NIL                                                (* sm: "25-NOV-82 14:02")
                                                             (* gives a popup menu to select other Test Links)
    (MENU (create MENU
		  ITEMS ←[QUOTE ((AlternateTestOf (QUOTE ATO))
				  (SubTestOf (QUOTE SUBO))
				  (UsedBy (QUOTE UB))
				  (ClassPreTest (QUOTE CPT]
		  TITLE ← "Other Test Links"])

(EditPreTest
  [LAMBDA (self link)                                        (* sm: "20-SEP-83 16:26")
                                                             (* allows user to edit a dependency list via a menu)
    (PROG (INP INP2 (Redo (QUOTE LOOP))
	       Rval)
          (COND
	    ((NULL link)
	      (RETURN NIL)))
          (printout TTY "Editing" -2 link "::" -2 (GetValue self link)
		    T)                                       (* if linkval is NIL, offer to add via Add menu)
          [COND
	    ((NULL (GetValue self link))
	      (SETQ INP (MENU (create MENU
				      ITEMS ←(QUOTE ((Add (QUOTE Add)
							  
				       "object name or list of names to be added along this link")
						      (AddNum (QUOTE AddNum)
							      
			       "enter a number for how many objects of this type are to be added")
						      (DefAdd (QUOTE DefAdd)
							      
			       "ClassName or (ClsName InsName)  to CREATE and then add an object")))
				      TITLE ← "Add Options")))
	      (COND
		(INP (SETQ Redo (QUOTE LOOP2]
      LOOP(COND
	    ((EQ Redo (QUOTE RETURN))
	      (RETURN Rval))
	    ((OR (NULL Redo)
		 (EQ Redo (QUOTE LOOP)))
	      (PRIN1 "LinkEdCmd:")
	      (SETQ INP (READ)))
	    ((EQ Redo (QUOTE LOOP2))                         (* for looping without reading again)
	      ))
          (SETQ Redo (QUOTE RETURN))
          [ERSETQ (SELECTQ INP
			   (Add (PRIN1 "ADD:")
				(SETQ INP2 (READ))
				(for x in (MKLIST INP2) do (PutValue self link x)))
			   [AddNum (COND
				     ((FMEMB link (QUOTE (PreTest UsesObj)))
				       (printout TTY "Not a valid way to add to" -2 link -2 
						 "Use Add commd"
						 T)
				       (SETQ Redo (QUOTE LOOP)))
				     (T (PRIN1 "Number:")
					(SETQ INP2 (READ))
					(COND
					  ((NOT (NUMBERP INP2))
					    (printout TTY "Enter a number!!" T)
					    (SETQ Redo (QUOTE LOOP2)))
					  (T [RPTQ INP2 (PutValue self link
								  (GetValue (SEND (FindObjForLink
										    link self)
										  New)
									    (QUOTE name]
					     (SETQ Redo (QUOTE LOOP]
			   (Delete (SETQ INP2 (ReadLinkMenu self link NIL T))
				   (for x in (MKLIST INP2) do (RemoveValue self link x))
				   (SETQ Redo (QUOTE LOOP)))
			   (Desc (DescribeTestLink self link)
				 (SETQ Redo (QUOTE LOOP)))
			   (DefAdd (PRIN1 "Class or (Class Inst)::")
				   (SETQ INP2 (MKLIST (READ)))
				   (COND
				     [(type? class (GetObjectRec (CAR INP2)))
				       (PutValue self link (GetValue (SEND (GetObjectRec
									     (CAR INP2))
									   New
									   (COND
									     ((CDR INP2)
									       (CADR INP2))
									     (T NIL)))
								     (QUOTE name]
				     (T (printout TTY (CAR INP2)
						  -2 "Not a class. Redo" T)))
				   (SETQ Redo (QUOTE LOOP)))
			   ((QUIT Quit Q))
			   (Modify (PRIN1 "NewList:")
				   (SETQ INP2 (READ))
				   (for x in (GetValue self link) do (RemoveValue self link x))
				   (for y in (MKLIST INP2) do (PutValue self link y))
				   (SETQ Redo (QUOTE LOOP)))
			   ((PP! PP)
			     (SETQ INP2 (ReadLinkMenu self link T T))
			     (for x in INP2 do (DoMethod (GetObjectRec x)
							 INP))
			     (SETQ Redo (QUOTE LOOP)))
			   [(Edit EDIT VEDIT Dedit EditIV EditCV)
			     (SETQ INP2 (ReadLinkMenu self link T T))
			     (for x in INP2 do (← (GetObjectRec x)
						  Edit
						  (SELECTQ INP
							   (VEDIT (QUOTE (EE)))
							   (Dedit (QUOTE (de)))
							   ((Edit EDIT)
							     NIL)
							   NIL]
			   (List (printout TTY (GetValue self link)
					   T)
				 (SETQ Redo (QUOTE LOOP)))
			   (Select (SETQ INP2 (ReadLinkMenu self link T T))
				   (SETQ Rval INP2))
			   (PROGN (COND
				    ((NULL INP))
				    (T (printout TTY "Illegal command" -3 INP -3 "Retry" T)))
				  (SETQ Redo (QUOTE LOOP]
          (GO LOOP])

(EditTestOtherCmds
  [LAMBDA NIL                                                (* sm: "24-NOV-82 18:33")
                                                             (* creates a popup menu for less often used commands for
							     EditTEST cmds)
    (MENU (create MENU
		  ITEMS ←(QUOTE ((Edit (QUOTE EDIT)
				       "edit using the lisp editor")
				  (EditIVs (QUOTE EDITIV)
					   "edit IVs only using TTYEdit")
				  (EditCVs (QUOTE EDITCV)
					   "edit CVs only using TTYEdit")
				  (PP!(QUOTE PP!)
				    "PP! of test object")
				  (ResetPre (QUOTE RESETPRE)
					    "reset test object and its pretests")
				  (ResetSub (QUOTE RESETSUB)
					    "reset test object and its subtests, syntax test etc")
				  (TestSub (QUOTE TESTSUB)
					   "test current object and all its subtests, syntax test")))
		  TITLE ← "Other Edit Cmds"])

(EvaluateANDALLTest
  [LAMBDA (self Test)                                        (* sm: "30-NOV-82 17:15")
                                                             (* evaluates test expressions with ANDALL for 
							     EvaluateTest)
                                                             (* evaluates all Clauses, even if one fails or causes 
							     error)
    (PROG (Msg (Res T)
	       FailedVal Val Exp)
          [for x in (CDR Test) do (PROGN (SETQ Val (ERRORSET (COND
							       ((ATOM x)
								 (SETQ Msg NIL)
								 (SETQ Exp x))
							       ((EQUAL (CAR x)
								       (QUOTE ATEST))
								 (SETQ Exp (CADR x))
								 [SETQ Msg (COND
								     ((NULL (CDDR x))
								       NIL)
								     (T (CADDR x]
								 Exp)
							       (T (SETQ Msg NIL)
								  (SETQ Exp x)))
							     T))
					 (COND
					   ((OR (NULL Val)
						(NULL (CAR Val)))
					     (SETQ FailedVal Val)
					     (SETQ FMSG (CONS [LIST Msg Exp (COND
								      ((NULL Val)
									"*ERROR*")
								      (T (CAR Val]
							      FMSG))
					     (SETQ Res NIL]
          (COND
	    ((NOT Res)
	      (RETURN FailedVal)))
          (RETURN Val])

(EvaluateANDTest
  [LAMBDA (self Test)                                        (* sm: "30-NOV-82 17:14")
                                                             (* evaluates test expressions with AND for EvaluateTest)
    (PROG (Msg (Res T)
	       Val Exp)
          [for x in (CDR Test) while Res do (PROGN (SETQ Val (ERRORSET (COND
									 ((ATOM x)
									   (SETQ Msg NIL)
									   (SETQ Exp x))
									 ((EQUAL (CAR x)
										 (QUOTE ATEST))
									   (SETQ Exp (CADR x))
									   [SETQ Msg
									     (COND
									       ((NULL (CDDR x))
										 NIL)
									       (T (CADDR x]
									   Exp)
									 (T (SETQ Msg NIL)
									    (SETQ Exp x)))
								       T))
						   (COND
						     ((OR (NULL Val)
							  (NULL (CAR Val)))
						       (SETQ Res NIL]
          [COND
	    ((NOT Res)
	      (SETQ FMSG (CONS (LIST Msg Exp (COND
				       ((NULL Val)
					 "*ERROR*")
				       (T (CAR Val]
          (RETURN Val])

(EvaluatePROGTest
  [LAMBDA (self Test)                                        (* sm: "30-NOV-82 17:17")
                                                             (* evaluates test expressions with PROG for 
							     EvaluateTest)
    (PROG (Msg (Res T)
	       Val Exp)
          [for x in (CDR Test) while Res do (PROGN (SETQ Val (ERRORSET (COND
									 ((ATOM x)
									   (SETQ Msg NIL)
									   (SETQ Exp x))
									 ((EQUAL (CAR x)
										 (QUOTE ATEST))
									   (SETQ Exp (CADR x))
									   [SETQ Msg
									     (COND
									       ((NULL (CDDR x))
										 NIL)
									       (T (CADDR x]
									   Exp)
									 (T (SETQ Msg NIL)
									    (SETQ Exp x)))
								       T))
						   (COND
						     ((NULL Val)
						       (SETQ Res NIL]
          [COND
	    ((NOT Res)
	      (SETQ FMSG (CONS (LIST Msg Exp (COND
				       ((NULL Val)
					 "*ERROR*")
				       (T (CAR Val]
          (RETURN Val])

(EvaluateTest
  [LAMBDA (self Field APFlg)                                 (* sm: "20-SEP-83 16:27")
                                                             (* evaluates testfield of a TestObj.
							     Returns: NIL -
							     if error; (LIST val) otherwise)

          (* APFlg -
	  determines if Exps without AND,ANDALL or PROGN are to be treated as one or the other. Default is PROGN, i.e. 
	  APFlg=NIL means PROGN will be used)



          (* Sets global FMSG as follows: for each failed test (error or NIL), makes a dotted pair from TestMsg and TestExp.
	  If no TestMsg, then makes dotted pair from TestExp and NIL.)

                                                             (* Expressions such as AND, ATEST etc receive special 
							     treatment)
    (PROG ((Test (GetValue self Field))
	   (DefType (QUOTE PROGN))
	   Res)
          (SETQ FMSG NIL)
          [COND
	    (APFlg (SETQ DefType (QUOTE AND]
          [COND
	    ((NULL Test)
	      (RETURN (QUOTE (T]
          [COND
	    ((ATOM Test)
	      (RETURN (ERRORSET Test T]
          [COND
	    [(MEMBER (CAR Test)
		     (QUOTE (PROGN AND ANDALL]
	    (T (SETQ Test (LIST DefType Test]
          [COND
	    ((EQUAL (CAR Test)
		    (QUOTE AND))
	      (RETURN (EvaluateANDTest self Test)))
	    ((EQUAL (CAR Test)
		    (QUOTE ANDALL))
	      (RETURN (EvaluateANDALLTest self Test)))
	    ((EQUAL (CAR Test)
		    (QUOTE PROGN))
	      (RETURN (EvaluatePROGTest self Test]
          (printout TTY "Should not reach here in function: EvaluateTest" T)
          (RETURN NIL])

(ExaminePreviousTry
  [LAMBDA (self TestedLst)                                   (* sm: "29-MAR-83 14:32")
                                                             (* checks the result of previous try at running this 
							     TestObj)
    (PROG (AltRes)
          [COND
	    ((ValueNonNIL? (%@ Tested?))
	      (RETURN (%@ Tested?]
          [SETQ AltRes (CONS (%@ Tested?)
			     (for x in (GetValue self (QUOTE AltTest)) collect (GetValue
										 (GetObjectRec x)
										 (QUOTE Tested?]
          (RETURN (COND
		    ((FMEMB T AltRes)
		      T)
		    ((OR (FMEMB NotSetValue AltRes)
			 (FMEMB (QUOTE U)
				AltRes))
		      (QUOTE U))
		    (T NIL])

(ExecTestFields
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:27")
                                                             (* executes one of the Test IVs -
							     selected from a menu)
    (PROG (INP RES)
          (SETQ INP (MENU (create MENU
				  ITEMS ←(QUOTE (SetUp TestExpr ResetExp))
				  TITLE ← "Test Fields")))
          (COND
	    (INP (printout TTY "Executing.." INP -2 .PPF (GetValue self INP)
			   T
			   (PROGN (SETQ RES (ERRORSET (GetValue self INP)
						      T))
				  (COND
				    (RES (CAR RES))
				    (T "Error..")))
			   T)))
          (RETURN self])

(FindObjForLink
  [LAMBDA (link self)                                        (* sm: "18-OCT-82 10:51")
                                                             (* returns the object corresp to the class that best 
							     determines the values of a particular dependency link)
    [COND
      ((NULL self)
	(SETQ self (%$ LOOPSTestObject]
    (SELECTQ link
	     (PreTest (Class self))
	     (CasesUsed (%$ LOOPSTestCases))
	     (SubTest (%$ LOOPSTestPrimitive))
	     (SyntaxTest (%$ LOOPSTestSyntax))
	     (UsesObj (%$ LOOPSTestSuper))
	     (AltTest (Class self])

(FlashTestBrowser
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "15-NOV-82 10:25")
                                                             (* This is a putFn for flashing the test node in 
							     testbrowser)
    [COND
      (LTBROWSER (COND
		   ((AND (NULL newValue)
			 (EQ (GetValue self varName propName)
			     NotSetValue))
		     (ERSETQ (← LTBROWSER FlashNode self 3]
    (PutLocalState activeVal newValue self varName propName type])

(GIVGetFn
  [LAMBDA (self varName localSt propName activeVal type)     (* sm: "29-MAR-83 16:43")
                                                             (* GetFn used in LTFGetInitialValue tests.
							     Attached to IVs GIV1 and GIV2 in LOOPSTestClass1)
    (ADD1 localSt])

(GenerateTestList
  [LAMBDA NIL                                                (* sm: "11-AUG-83 13:26")
                                                             (* returns Seed.HasTest, where Seed is list of tests 
							     with no preconditions and HasTest is list of all tests 
							     which are DEFINED)
                                                             (* sets global AllTest)
    (PROG (HasTest Seed)
          [SETQ AllTest (APPEND (GetClassValue (%$ LOOPSTestBasic)
					       (QUOTE Instances))
				(GetClassValue (%$ LOOPSTestBraidObject)
					       (QUOTE Instances))
				(GetClassValue (%$ LOOPSTestKernel)
					       (QUOTE Instances))
				(GetClassValue (%$ LOOPSTestLispFunc)
					       (QUOTE Instances))
				(GetClassValue (%$ LOOPSTestMethod)
					       (QUOTE Instances))
				(COND
				  (KBTestsFlg (GetClassValue (%$ LOOPSTestEnvironment)
							     (QUOTE Instances)))
				  (T NIL]
          (SETQ HasTest (for x in AllTest eachtime (SETQ y (GetObjectRec x))
			   when (OR (GetValue y (QUOTE TestExpr))
				    (GetValue y (QUOTE PreTestOf))
				    (GetValue y (QUOTE PreTest)))
			   collect y))
          (SETQ Seed (for x in HasTest when [AND (NULL (GetValue x (QUOTE PreTest] collect x))
          (RETURN (CONS Seed HasTest])

(GetFromActVal
  [LAMBDA (self varName localSt propName activeVal type)     (* sm: "25-OCT-82 15:22")
                                                             (* This is a getFn for testing Active Values)
                                                             (* It returns the local state, going down to embedded 
							     Act Val if necessary)
    (GetLocalState activeVal self varName propName])

(InformTestBrowser
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "29-MAR-83 15:42")
                                                             (* This is a putFn for informing TestBrowser if testobj 
							     node is to be flashed or flipped)
    [COND
      (LTBROWSER (COND
		   ((AND (UnknownValue? (GetValue self varName propName))
			 (ValueExists? newValue))
		     (ERSETQ (DoMethod LTBROWSER (COND
					 ((EQ newValue T)
					   (QUOTE FlipNode))
					 (T (QUOTE FlashNode)))
				       NIL self 5)))
		   ((AND (UnknownValue? newValue)
			 (EQ (GetValue self varName propName)
			     T))
		     (ERSETQ (← LTBROWSER FlipNode self]
    (PutLocalState activeVal newValue self varName propName type])

(LOOPSTestEnvironment.TEST
  [LAMBDA (self TestedLst)                                   (* sm: "16-NOV-82 17:01")
                                                             (* does TEST for Environment tests)
    (PROG NIL
          (←Super
	    self TEST TestedLst)
          [COND
	    ((EQ (GetValue self (QUOTE SetUp)
			   (QUOTE Tested?))
		 T)
	      (ERRORSET (GetValue self (QUOTE AfterTest]
          (RETURN (%@ Tested?])

(LOOPSTestObject.DefineTEST
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:27")
                                                             (* used to define Test description for a TestObj.)
                                                             (* This general proc may be used in conjunction with 
							     more specialized ones)
    (PROG (Name PreTest Cmd)
          (SETQ Name (@ name))
          (printout TTY " Please do not change the dependency lists in the editor" T)
          (SEND self Edit)
          (COND
	    ((NULL (GetValueOnly self (QUOTE PreTest)))
	      (AskPreTest self)))
          (COND
	    ((NULL (@ CasesUsed))
	      (AskTestCases self)))
          (COND
	    ((NULL (@ SyntaxTest))
	      (AskSyntaxTest self)))
          (COND
	    ((NULL (@ SubTest))
	      (AskSubTest self)))
          (RETURN self])

(LOOPSTestObject.Describe
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:27")
                                                             (* prints a description of the TestObj)
    (PROG NIL
          (printout TTY "Test Desc::" -2 (@ TestDesc)
		    T)
          (COND
	    ((@ self Tested? DoneOnce)
	      (DescribePreviousTry self))
	    (T (printout TTY "Not tested yet. To test, send TEST message or use TestBrowser" T])

(LOOPSTestObject.EditTEST
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:28")
                                                             (* edits a TestObj using menus)
    (PROG ((EditTestObj self)
	   (Stack (CONS self))
	   (Redo T)
	   INP2 INP)
          [COND
	    (EditTestWindows (for x in EditTestWindows do (OPENW x)))
	    (T (SETQ EditTestWindows (SetupEditTestObjMenu]
          (printout TTY "Editing Test Object:" -4 (@ name)
		    T)
      LOOP(COND
	    (Redo (PRIN1 "EditCmd:"))
	    (T (RETURN self)))
          [ERSETQ (SELECTQ (SETQ INP (READ))
			   ((Quit QUIT Q q)
			     [MAPC EditTestWindows (FUNCTION (LAMBDA (X)
				       (CLOSEW X]
			     (SETQ Redo NIL))
			   [DEDIT (printout TTY "Please do not edit dependency link fields" T)
				  (SEND EditTestObj Edit (QUOTE (de]
			   [(EE VEDIT)
			     (printout TTY "Please do not edit dependency link fields" T)
			     (SEND EditTestObj Edit (QUOTE (ee]
			   (EDIT (SEND EditTestObj Edit))
			   ((PP PP!)
			     (ERSETQ (DoMethod EditTestObj INP)))
			   (DESCRIBE (ERSETQ (SEND EditTestObj Describe)))
			   (WHO (printout TTY "Editing:" (ObjectName EditTestObj)
					  T))
			   (TOP (SETQ Stack (LAST Stack))
				(SETQ EditTestObj (CAR Stack))
				(printout TTY "Editing:" -3 EditTestObj T))
			   [SELECT (PRIN1 "ObjName:")
				   (SETQ INP2 (READ))
				   (COND
				     ((GetObjectRec INP2)
				       (SETQ Stack (CONS EditTestObj Stack))
				       (SETQ EditTestObj (GetObjectRec INP2)))
				     (T (printout TTY INP2 -3 "Not an object. Redo command" T]
			   (REMEMBER (SETQ Stack (CONS EditTestObj Stack)))
			   [UNREMEMBER (SETQ EditTestObj (GetObjectRec (CAR Stack)))
				       (printout TTY "Editing:" (ObjectName EditTestObj)
						 T)
				       (SETQ Stack (COND
					   ((EQ (LENGTH Stack)
						1)
					     Stack)
					   (T (CDR Stack]
			   [(PT CU SUB ST AT UO PTO SUBO ATO STO CPT UB)
			     [SETQ INP2 (EditPreTest EditTestObj (SELECTQ INP
									  (PT (QUOTE PreTest))
									  (SUB (QUOTE SubTest))
									  (PTO (QUOTE PreTestOf))
									  (CU (QUOTE CasesUsed))
									  (ST (QUOTE SyntaxTest))
									  (AT (QUOTE AltTest))
									  (UO (QUOTE UsesObj))
									  (SUBO (QUOTE SubTestOf))
									  (ATO (QUOTE AltTestOf))
									  (STO (QUOTE SyntaxTestOf))
									  (printout TTY 
							       "Cannot edit along this link YET!"
										    T]
			     (COND
			       (INP2 (SETQ Stack (APPEND (CDR INP2)
							 (CONS EditTestObj Stack)))
				     (SETQ EditTestObj (GetObjectRec (CAR INP2)))
				     (printout TTY "Editing:" -4 (ObjectName EditTestObj)
					       T]
			   (EVAL (UE))
			   (EXEC (ExecTestFields EditTestObj))
			   (TEST (ERSETQ (SEND EditTestObj TEST)))
			   (RETEST (ERSETQ (SEND EditTestObj ReTest)))
			   (TESTSUB (ERSETQ (SEND EditTestObj TEST!)))
			   (RESET (ERSETQ (SEND EditTestObj ResetSelf)))
			   (RESETPRE (ERSETQ (SEND EditTestObj Reset)))
			   (RESETSUB (ERSETQ (SEND EditTestObj Reset!)))
			   (? (printout TTY "Use the menu" T))
			   (COND
			     ((NULL INP))
			     (T (printout TTY "Illegal command. " -3 INP T]
          (GO LOOP])

(LOOPSTestObject.EditTestInTTYProcess
  [LAMBDA (self)                                             (* sm: "31-MAY-83 16:17")
                                                             (* calls EditTEST in TTY Process)
    (EVAL.IN.TTY.PROCESS (LIST (QUOTE ←)
			       self
			       (QUOTE EditTEST])

(LOOPSTestObject.GetTestCode
  [LAMBDA (self)                                             (* sm: "21-OCT-82 14:04")
                                                             (* returns the Test Code fields)
    (MAPCAR (QUOTE (SetUp TestExpr ResetExp))
	    (QUOTE (LAMBDA (X)
			   (LIST X (GetValue self X])

(LOOPSTestObject.TEST
  [LAMBDA (self TestedLst)                                   (* sm: "20-SEP-83 16:28")
                                                             (* performs the basic TEST for a TestObject)
    (PROG (FMSG (TestingObject self)
		PrevRes HELPFLAG (HeaderFlag T))             (* HeaderFlag is used by: PreTestsSatisfied?, 
							     DoTestSelf)
          (CloseCurrentEnvironment)
          (AND CurrentEnvironment (SEND CurrentEnvironment MakeNotCurrent))
          (PutValue self (QUOTE Tested?)
		    T
		    (QUOTE DoneOnce))
          (COND
	    ([AND TestedLst (NOT (FMEMB self (CAR TestedLst]
	      (TCONC TestedLst self)))
          (COND
	    ((ValueExists? (SETQ PrevRes (ExaminePreviousTry self TestedLst)))
	      (PrintIfLev LTMsgLev 7 (printout TTY "Test for " -4 (@ TestDesc)
					       -4 "was" -5 (COND
						 (PrevRes "Successful")
						 (T "Unsuccessful"))
					       T))
	      (RETURN PrevRes)))                             (* check pretests)
          (AND LTBROWSER (← LTBROWSER BoxNode self))
          (COND
	    ((EQ (SETQ Res (PreTestsSatisfied? self TestedLst))
		 T))
	    (T                                               (* pretests failed. Return)
	       (AND LTBROWSER (← LTBROWSER BoxNode self))
	       (RETURN Res)))
          (RETURN (DoTestSelf self TestedLst])

(LOOPSTestObject.TEST!
  [LAMBDA (self ContFl)                                      (* sm: "20-SEP-83 16:29")
                                                             (* first TESTs itself, and if successful, then does 
							     other tests- SubTest, SyntaxTest, AltTest.)
                                                             (* Sets IV CompletelyTested? if SubTest and SyntaxTest 
							     are successful)
                                                             (* ContFl if T, then continues, even if basic test 
							     failed. this may be useful in some cases)
    (PROG (TestRes)                                          (* Check if already CompletelyTested?)
          [COND
	    ((ValueExists? (@ CompletelyTested?))
	      (printout TTY "Overall Test for" -4 (@ TestDesc)
			-4 "was" -5 (COND
			  ((@ CompletelyTested?)
			    "Successful")
			  (T "Unsuccessful"))
			T)
	      (RETURN (@ CompletelyTested?]
          (SEND self TEST)
          [COND
	    ([AND (NOT (EQ ContFl T))
		  (NOT (ValueNonNIL? (GetValue self (QUOTE Tested?]
	      (printout TTY "Not proceeding with complete test of.." -4 (@ TestDesc)
			T)
	      (←@
		CompletelyTested? NotSetValue)
	      (RETURN (@ CompletelyTested?]
          (COND
	    ([NOT (ValueNonNIL? (GetValue self (QUOTE Tested?]
	      (printout TTY 
   "Proceeding with complete test, even though this feature failed.  Interpret results CAREFULLY"
			T)))
          (DoLoopsTest self (QUOTE SubTest)
		       (QUOTE TEST!)
		       ContFl)
          (DoLoopsTest self (QUOTE SyntaxTest)
		       (QUOTE TEST!)
		       ContFl)
          (DoLoopsTest self (QUOTE AltTest)
		       (QUOTE TEST!)
		       ContFl)
          [PutValue self (QUOTE CompletelyTested?)
		    (PROGN [SETQ TestRes (LIST (@ Tested?)
					       (GetValue self (QUOTE SubTest)
							 (QUOTE Tested?))
					       (GetValue self (QUOTE SyntaxTest)
							 (QUOTE Tested?]
			   (COND
			     ((FMEMB NotSetValue TestRes)
			       NotSetValue)
			     ((FMEMB NIL TestRes)
			       NIL)
			     (T T]
          (printout TTY "Overall test for" -4 (@ TestDesc)
		    -4 "was" -5 (SELECTQ (@ CompletelyTested?)
					 (NIL "Unsuccessful")
					 (T "Successful")
					 (QUOTE "Indeterminate"))
		    -2 TestRes T)
          (RETURN (@ CompletelyTested?])

(LOOPSTestObject.TESTDep
  [LAMBDA (self)                                             (* sm: "13-DEC-82 13:15")
                                                             (* generates TEST call to self, and TESTDep to PreTestOf
							     list, and SubTest list only if it succeeds)
                                                             (* Returns list of objects called)
    (PROG (Called)
          (SETQ Called (LIST self))
          (SEND self TEST)
          [COND
	    ((ValueNonNIL? (%@ Tested?))
	      (NCONC Called (for x in (GetValue self (QUOTE SubTest)) join (← (GetObjectRec x)
									      TESTDep))
		     (for x in (GetValue self (QUOTE PreTestOf)) join (← (GetObjectRec x)
									 TESTDep]
          (RETURN Called])

(LOOPSTestObject.TESTall
  [LAMBDA (self)                                             (* sm: "26-OCT-82 11:35")
                                                             (* generates TEST call to self, PreTestOf list, and 
							     SubTest list)
                                                             (* Returns list of objects called)
    (PROG (Called)
          (SETQ Called (LIST self))
          (SEND self TEST)
          (NCONC Called (for x in (GetValue self (QUOTE SubTest)) join (SEND (GetObjectRec x)
									     TESTall))
		 (for x in (GetValue self (QUOTE PreTestOf)) join (SEND (GetObjectRec x)
									TESTall)))
          (RETURN Called])

(LOOPSTestObject.TestSelf
  [LAMBDA (self TestedLst)                                   (* sm: "20-SEP-83 16:29")
                                                             (* performs the basic TEST for a TestObject but 
							     continues even if PreTests fail)
    (PROG (FMSG (TestingObject self)
		PrevRes HELPFLAG (HeaderFlag T))             (* HeaderFlag is used by: PreTestsSatisfied?, 
							     DoTestSelf)
          (CloseCurrentEnvironment)
          (AND CurrentEnvironment (SEND CurrentEnvironment MakeNotCurrent))
          (PutValue self (QUOTE Tested?)
		    T
		    (QUOTE DoneOnce))
          (COND
	    ([AND TestedLst (NOT (FMEMB self (CAR TestedLst]
	      (TCONC TestedLst self)))
          (COND
	    ((ValueExists? (SETQ PrevRes (ExaminePreviousTry self TestedLst)))
	      (PrintIfLev LTMsgLev 7 (printout TTY "Test for " -4 (@ TestDesc)
					       -4 "was" -5 (COND
						 (PrevRes "Successful")
						 (T "Unsuccessful"))
					       T))
	      (RETURN PrevRes)))                             (* check pretests)
          (AND LTBROWSER (← LTBROWSER BoxNode self))
          (COND
	    ((EQ (SETQ Res (PreTestsSatisfied? self TestedLst))
		 T))
	    (T                                               (* pretests failed. Return)
	       (printout TTY "PreTests failed for" -4 (@ TestDesc)
			 -4 "Nonethless, continuing with test - interpret results accordingly" T)))
          (RETURN (DoTestSelf self TestedLst])

(LOOPSTestPrimitive.XTEST
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:30")
                                                             (* performs the basic TEST for a Primitive TestObject 
							     ONLYIF its super test Tested T and sets own Tested? IV)
    (PROG (TestExp Resp Sval Tval)
          [COND
	    ((ValueExists? (@ Tested?))
	      (printout TTY "Basic Test for " -4 (@ TestDesc)
			-4 "was" -5 (COND
			  ((@ Tested?)
			    "Successful")
			  (T "Unsuccessful"))
			T)
	      (RETURN (@ Tested?]
          (printout TTY "TESTING.." -4 (@ TestDesc)
		    T)
          (COND
	    ((NOT (EQ (CheckClassTest self)
		      T))
	      (printout TTY 5 "Basic test for this class failed. Stopping.." T)
	      (RETURN NotSetValue)))                         (* The class PreTest were successful so continue...)
          (COND
	    ((NOT (EQ (CheckPreTest self)
		      T))
	      (printout TTY 5 "Basic pretests failed. Cannot test further.." T)
	      (RETURN NotSetValue)))                         (* Now test the object)
          (SETQ TestExp (@ TestExpr))
          [COND
	    ((NULL TestExp)
	      (printout TTY 5 "No test is currently available for.." -3 (@ TestDesc)
			T 5 "Indicate if this feature works OK?")
	      (SETQ Resp (READ))
	      (RETURN (COND
			((FMEMB Resp (QUOTE (y t Y Yes T True YES TRUE)))
			  (←@
			    Tested? T))
			((FMEMB Resp (QUOTE (n f N No F FALSE NO False nil NIL)))
			  (←@
			    Tested? NIL))
			(T NotSetValue]
          (SETQ Sval (ERRORSET (@ SetUp)
			       T))
          (COND
	    ((NULL Sval)
	      (printout TTY 5 "Error in setting up the test environment. Cannot test further.." T)
	      (RETURN NotSetValue)))
          (SETQ Tval (ERRORSET (@ TestExpr)
			       T))
          (COND
	    ((OR (NULL Tval)
		 (NULL (CAR Tval)))
	      (printout TTY "Test failed for.." (@ TestDesc)
			T 10 "Send bug report to LOOPSCORE↑.pa" T)
	      (←@
		Tested? NIL))
	    (T (printout TTY "Test successful!! for.." (@ TestDesc)
			 T)
	       (←@
		 Tested? T)))
          (RETURN (@ Tested?])

(LinkEditOtherMenu
  [LAMBDA NIL                                                (* sm: "29-MAR-83 16:08")
                                                             (* popup menu for other commands for editing Test Link 
							     objects)
    (MENU (create MENU
		  ITEMS ←(QUOTE (PP! (Edit (QUOTE Edit)
					   "edit using Lisp editor")
				     (EditIVs (QUOTE EditIV)
					      "edit IVs only using TTYEdit")
				     (EditCVs (QUOTE EditCV)
					      "edit CVs only using TTYEdit")
				     (Modify (QUOTE Modify)
					     "replace current values by new list")))
		  TITLE ← "Other Cmds"])

(LOOPSTestMeta.BeginLOOPSTest
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:31")
                                                             (* TESTS THE KERNEL FEATURES OF LOOPS)
    (PROG (LTKInst LTKClass Temp)                            (* TEST: Create a new class)
                                                             (* Also test that Class is set properly)
          (DC (QUOTE LTClass)
	      (QUOTE (Object)))
          (COND
	    ((EQ (SETQ LTKClass (GetClass ($ LTClass)))
		 ($ Class)))
	    (T (printout TTY "Bug: Class of a newly created class not set properly" -5 LTKClass T)))
                                                             (* TEST: Create an instance of this)
                                                             (* Also test that Class is set properly)
                                                             (* Also tests message passing and Method Inheritance)
          (SETQ LTKInst (← ($ LTClass)
			   New))
          (COND
	    ((EQ (SETQ LTKClass (Class LTKInst))
		 ($ LTClass)))
	    (T (printout TTY "Bug: Class of an instance of LTKernel not set properly" -5 LTKClass T)))
                                                             (* TEST: Add CV and IVs to the class and Get from 
							     Instance)
                                                             (* Tests inheritance of IV and CVs)
          (← ($ LTClass)
	     Add
	     (QUOTE CV)
	     (QUOTE CVTest1)
	     (QUOTE CVal1))
          (← ($ LTClass)
	     Add
	     (QUOTE IV)
	     (QUOTE IVTest1)
	     (QUOTE IVal1))
          (← ($ LTClass)
	     Add
	     (QUOTE IV)
	     (QUOTE IVTest2)
	     (QUOTE IVal2))
          (COND
	    [(EQUAL (GetClassValue ($ LTClass)
				   (QUOTE CVTest1))
		    (GetClassValue LTKInst (QUOTE CVTest1]
	    (T (printout TTY "Bug: CVs not being inherited properly" T)))
          (COND
	    [(EQUAL (GetValue ($ LTClass)
			      (QUOTE IVTest1))
		    (GetValue LTKInst (QUOTE IVTest1]
	    (T (printout TTY "Bug: IVs not being inherited properly" T)))
          (PutValue LTKInst (QUOTE IVTest2)
		    (QUOTE IVal3))
          (COND
	    ((EQUAL (GetValue ($ LTClass)
			      (QUOTE IVTest2))
		    (GetValue LTKInst (QUOTE IVTest2)))
	      (printout TTY "Bug: Inherited Values are overriding local values" T)))
                                                             (* TEST: Destroy the instance and its class)
          (← LTKInst Destroy)
          (← ($ LTClass)
	     Destroy)
          [SETQ Temp (ERSETQ (GetClass ($ LTClass]
          (COND
	    [(OR (NULL Temp)
		 (NULL (CAR Temp]
	    (T (printout TTY "Bug: Class Object not destroyed properly: GetClass returns non-NIL" T)))
          (printout TTY "Kernel Test Completed." T 
		    "Following features seem to be OK, unless indicated by an earlier message "
		    T "Creation of a new class" T "Instantiating a class using NEW message" T 
		    "Setting of Class links"
		    T "Inheritance of methods" T "Inheritance of IVs and CVs" T 
		    "Destruction of a class and its instance"
		    T "Following functions/methods partially tested" T "FUNCTIONS:" .PARA 15 -2
		    (QUOTE ("DC" "GetClass" "Class" "GetClassValue" "GetValue" "PutValue"))
		    T "METHODS:" .PARA 15 -2 (QUOTE ("New" "Add" "Destroy"))
		    T)
          (RETURN T])

(LOOPSTestMeta.GetTestCode
  [LAMBDA (self)                                             (* sm: "21-OCT-82 14:07")
                                                             (* returns NIL, as no TestCode yet)
    NIL])

(LOOPSTestMeta.New
  [LAMBDA (self name)                                        (* sm: " 6-OCT-82 13:36")
                                                             (* inherits its Super's New and then adds the instance's
							     name to filecoms and CV Instances)
                                                             (* if name is NIL, generate a name)
    [COND
      (name)
      (T (SETQ name (PACK* (GetClassValue self (QUOTE InstancePrefix))
			   (←%@%@
			     UnnamedInstanceCount
			     (ADD1 (%@%@ UnnamedInstanceCount]
    (←Super
      self New name)
    (PushClassValueNew self (QUOTE Instances)
		       name)
    (EVAL (LIST (QUOTE PUSHNEW)
		(GetClassValue self (QUOTE InstanceComsVar))
		(KWOTE name)))
    (GetObjectRec name])

(LOOPSTestKernel.TEST
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:31")
                                                             (* TESTS THE KERNEL FEATURES OF LOOPS)
    (PROG (LTKInst LTKClass Temp)                            (* TEST: Create a new class)
                                                             (* Also test that Class is set properly)
          (COND
	    ((NOT (EQ (@ Tested?)
		      NotSetValue))
	      (printout TTY "Kernel Test was " (COND
			  ((NULL (@ Tested?))
			    "Unsuccessful")
			  (T "Successful"))
			T)
	      (RETURN (@ Tested?)))
	    (T (printout TTY "Begin test of Kernel features of LOOPS..." T)))
          (DC (QUOTE LTClass)
	      (QUOTE (Object)))
          (COND
	    ((EQ (SETQ LTKClass (GetClass ($ LTClass)))
		 ($ Class)))
	    (T (printout TTY "Bug: Class of a newly created class not set properly" LTKClass T)))
                                                             (* TEST: Create an instance of this)
                                                             (* Also test that Class is set properly)
                                                             (* Also tests message passing and Method Inheritance)
          (SETQ LTKInst (← ($ LTClass)
			   New))
          (COND
	    ((EQ (SETQ LTKClass (Class LTKInst))
		 ($ LTClass)))
	    (T (printout TTY "Bug: Class of an instance of LTClass not set properly" LTKClass T)))
                                                             (* TEST: Add CV and IVs to the class and Get from 
							     Instance)
                                                             (* Tests inheritance of IV and CVs)
          (← ($ LTClass)
	     Add
	     (QUOTE CV)
	     (QUOTE CVTest1)
	     (QUOTE CVal1))
          (← ($ LTClass)
	     Add
	     (QUOTE IV)
	     (QUOTE IVTest1)
	     (QUOTE IVal1))
          (← ($ LTClass)
	     Add
	     (QUOTE IV)
	     (QUOTE IVTest2)
	     (QUOTE IVal2))
          (COND
	    [(EQUAL (GetClassValue ($ LTClass)
				   (QUOTE CVTest1))
		    (GetClassValue LTKInst (QUOTE CVTest1]
	    (T (←@
		 Tested? NIL)
	       (printout TTY " TestMsg: CVs not being inherited properly" T)))
          (COND
	    [(EQUAL (GetValue ($ LTClass)
			      (QUOTE IVTest1))
		    (GetValue LTKInst (QUOTE IVTest1]
	    (T (←@
		 Tested? NIL)
	       (printout TTY "TestMsg: IVs not being inherited properly" T)))
          (PutValue LTKInst (QUOTE IVTest2)
		    (QUOTE IVal3))
          (COND
	    ((EQUAL (GetValue ($ LTClass)
			      (QUOTE IVTest2))
		    (GetValue LTKInst (QUOTE IVTest2)))
	      (←@
		Tested? NIL)
	      (printout TTY "TestMsg: Inherited Values are overriding local values" T)))
                                                             (* TEST: Destroy the instance and its class)
          (← LTKInst Destroy)
          (← ($ LTClass)
	     Destroy)
          [SETQ Temp (ERSETQ (GetClass ($ LTClass]
          (COND
	    [(OR (NULL Temp)
		 (NULL (CAR Temp]
	    (T (printout TTY "Class Object not destroyed properly: GetClass returns non-NIL" T)))
          (COND
	    ((NULL (@ Tested?)))
	    (T (←@
		 Tested? T)))
          (printout TTY "Kernel features test  " -2 (COND
		      ((NULL (@ Tested?))
			"failed.. Send bug report to LOOPSCORE↑.pa")
		      (T "Successfully!!"))
		    T)
          (RETURN (@ Tested?])

(LOOPSClassSuper.Destroy
  [LAMBDA (self)                                             (* sm: " 5-OCT-82 14:30")
                                                             (* destroys an instance; updates Instancecoms var and CV
							     Instances)
    (PROG (name)
          (SETQ name (%@ name))
          (←%@%@
	    Instances
	    (DREMOVE name (%@%@ Instances)))
          [SET (%@%@ InstanceComsVar)
	       (DREMOVE name (EVAL (%@%@ InstanceComsVar]
          (←Super
	    self Destroy)
          (RETURN name])

(LOOPSClassSuper.GetTestCode
  [LAMBDA (self)                                             (* sm: "21-OCT-82 14:06")
                                                             (* returns NIL, as there is currently no Test Code here)
    NIL])

(LOOPSTestObject.ReTest
  [LAMBDA (self TestedLst)                                   (* sm: "20-SEP-83 16:32")
                                                             (* sends a ResetSelf if needed followed by TEST)
    (PROG (Res)
          (COND
	    ((@ self Tested? DoneOnce)
	      (← self ResetSelf)))
          (SETQ Res (← self TEST TestedLst))
          (COND
	    ((EQ Res T)
	      (printout TTY "Test was successful!!" T)))
          (RETURN Res])

(LOOPSTestObject.ReTestDep
  [LAMBDA (self)                                             (* sm: "30-NOV-82 12:55")
                                                             (* first sends ResetDep and then TESTDep to self)
    (← self ResetDep)
    (← self TESTDep])

(LOOPSTestObject.Reset
  [LAMBDA (self AlreadyReset)                                (* sm: "25-NOV-82 15:58")
                                                             (* resets the Tested type values so prior test results 
							     are wiped out. Also Resets PreTest and ClassPreTest)
    (PROG (HELPFLAG)
          [COND
	    ((NULL AlreadyReset)
	      (SETQ AlreadyReset (CONS]
          [COND
	    ((NOT (FMEMB (%@ name)
			 (CAR AlreadyReset)))
	      (TCONC AlreadyReset (%@ name))
	      (← self ResetSelf AlreadyReset)
	      (for x in (%@ PreTest) do (SEND (GetObjectRec x)
					      Reset AlreadyReset))
	      (for x in (%@%@ ClassPreTest) do (SEND (GetObjectRec x)
						     Reset AlreadyReset]
          (RETURN T])

(LOOPSTestObject.Reset!
  [LAMBDA (self ResetLst)                                    (* sm: "25-NOV-82 16:01")
                                                             (* resets itself by sending Reset to self and also 
							     Reset! its SyntaxTest, AltTest and SubTest.
							     Also does a Reset on PreTest and ClassPreTest)
                                                             (* ResetLst is a list to which obj names are added as 
							     they are reset. It is initially NIL)
    (PROG (HELPFLAG)                                         (* If ResetLst is NIL, create a pointer for it)
          [COND
	    ((NULL ResetLst)
	      (SETQ ResetLst (CONS]
          [COND
	    ((NOT (FMEMB (%@ name)
			 (CAR ResetLst)))
	      (TCONC ResetLst (%@ name))
	      (for x in (%@ AltTest) do (← (GetObjectRec x)
					   Reset! ResetLst))
	      (for x in (%@ SyntaxTest) do (← (GetObjectRec x)
					      Reset! ResetLst))
	      (for x in (%@ SubTest) do (← (GetObjectRec x)
					   Reset! ResetLst))
	      (← self ResetSelf ResetLst)
	      (for x in (%@ PreTest) do (← (GetObjectRec x)
					   Reset ResetLst))
	      (for x in (%@%@ ClassPreTest) do (← (GetObjectRec x)
						  Reset ResetLst]
          (RETURN ResetLst])

(LOOPSTestObject.ResetAll
  [LAMBDA (self ResetLst)                                    (* sm: "29-NOV-82 15:16")
                                                             (* completely resets itself, all tests on which it 
							     depends, and all which depend on it)
                                                             (* ResetLst is a list to which obj names are added as 
							     they are reset. It is initially NIL)
    (PROG (HELPFLAG)                                         (* If ResetLst is NIL, create a pointer for it)
          [COND
	    ((NULL ResetLst)
	      (SETQ ResetLst (CONS]
          [COND
	    ((NOT (FMEMB (%@ name)
			 (CAR ResetLst)))
	      (TCONC ResetLst (%@ name))
	      (for x in (%@ AltTest) do (← (GetObjectRec x)
					   ResetAll ResetLst))
	      (for x in (%@ SyntaxTest) do (← (GetObjectRec x)
					      ResetAll ResetLst))
	      (for x in (%@ SubTest) do (← (GetObjectRec x)
					   ResetAll ResetLst))
	      (for x in (%@ PreTestOf) do (← (GetObjectRec x)
					     ResetAll ResetLst))
	      (← self ResetSelf ResetLst)
	      (for x in (%@ PreTest) do (← (GetObjectRec x)
					   ResetAll ResetLst))
	      (for x in (%@%@ ClassPreTest) do (← (GetObjectRec x)
						  ResetAll ResetLst]
          (RETURN ResetLst])

(LOOPSTestObject.ResetDep
  [LAMBDA (self ResetLst)                                    (* sm: "29-NOV-82 15:08")
                                                             (* resets itself and all tests which depend on it)
                                                             (* resets itself by sending Reset to self and also 
							     Reset! its SyntaxTest, AltTest and SubTest.
							     Also does a Reset on PreTestOf list)
                                                             (* ResetLst is a list to which obj names are added as 
							     they are reset. It is initially NIL)
    (PROG (HELPFLAG)                                         (* If ResetLst is NIL, create a pointer for it)
          [COND
	    ((NULL ResetLst)
	      (SETQ ResetLst (CONS]
          (COND
	    ((NOT (FMEMB (%@ name)
			 (CAR ResetLst)))
	      (TCONC ResetLst (%@ name))
	      (for x in (%@ AltTest) do (← (GetObjectRec x)
					   ResetDep ResetLst))
	      (for x in (%@ SyntaxTest) do (← (GetObjectRec x)
					      ResetDep ResetLst))
	      (for x in (%@ SubTest) do (← (GetObjectRec x)
					   ResetDep ResetLst))
	      (for x in (%@ PreTestOf) do (← (GetObjectRec x)
					     ResetDep ResetLst))
	      (← self ResetSelf ResetLst)))
          (RETURN ResetLst])

(LOOPSTestObject.ResetSelf
  [LAMBDA (self AlreadyReset)                                (* sm: "20-SEP-83 16:32")
                                                             (* resets the Tested type values so prior test results 
							     are wiped out.)
    (PROG NIL
          (COND
	    ((ValueNonNIL? (@ self Tested? DoneOnce))
	      (printout TTY "RESETting.." -4 (@ name)
			T)
	      (for x in (@@ ResetList) do (SELECTQ (CAR x)
						   [IV (for y in (CDR x)
							  do (COND
							       ((ATOM y)
								 (PutValue self y NotSetValue))
							       (T (PutValue self (CAR y)
									    NotSetValue
									    (CADR y]
						   [CV (for y in (CDR x)
							  do (COND
							       ((ATOM y)
								 (PutClassValue self y NotSetValue))
							       (T (PutClassValue self (CAR y)
										 NotSetValue
										 (CADR y]
						   (printout TTY "Illegal ResetList.." T x T ".. for" 
							     -4 (@ name)
							     T)))
	      (ERRORSET (@ ResetExp)
			T))
	    (T (printout TTY (@ name)
			 "  is already Reset" T)
	       (RETURN NIL)))
          (RETURN T])

(MakeBackLink
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "20-SEP-83 16:32")

          (* This is a putFn for maintaining bi-links between TestCases and TestObject instances but could be used generally
	  too. Uses BackLink prop to find name of back link. Should NOT be invoked with other than PutValue.)

                                                             (* SPL CASES: (a) if newValue is of the form 
							     (- v1 ..vn), then removes v1 to vn)
                                                             (* (b) if newValue is of the form 
							     (v1 ..vn), then adds only those vi which are already not
							     there)
    (PROG [(blink (GetValue self varName (QUOTE BackLink]    (* if newValue is atom, make it a list)
          [COND
	    ((ATOM newValue)
	      (SETQ newValue (CONS newValue]
          [COND
	    [(EQ (CAR newValue)
		 (QUOTE -))
	      (for x in (CDR newValue)
		 do (COND
		      [(FMEMB blink (SEND (GetObjectRec x)
					  List!(QUOTE IVs)))
			(COND
			  ((FMEMB x (GetLocalState activeVal self varName propName))
			    (PutLocalState activeVal (DREMOVE x (GetLocalState activeVal self varName 
									       propName))
					   self varName propName type)
			    (PutValue (GetObjectRec x)
				      blink
				      (LIST (QUOTE -)
					    (@ name)))
			    (MARKASCHANGED (GetObjectName self)
					   (QUOTE INSTANCES))
			    (MARKASCHANGED x (QUOTE INSTANCES]
		      (T (printout TTY blink -2 "Not valid link for " x -2 "Ignoring.." T]
	    (T (for x in newValue do (COND
				       [(FMEMB blink (SEND (GetObjectRec x)
							   List!(QUOTE IVs)))
					 (COND
					   ((NOT (FMEMB x (GetLocalState activeVal self varName 
									 propName)))
					     (PutLocalState activeVal
							    (CONS x (GetLocalState activeVal self 
										   varName propName))
							    self varName propName type)
					     (PutValue (GetObjectRec x)
						       blink
						       (@ name))
					     (MARKASCHANGED (GetObjectName self)
							    (QUOTE INSTANCES))
					     (MARKASCHANGED x (QUOTE INSTANCES]
				       (T (printout TTY blink -2 "Not valid link for " x -2 
						    "Ignoring.."
						    T]
          (RETURN (GetLocalState activeVal self varName propName])

(MakeSet
  [LAMBDA (lis)                                              (* sm: "26-OCT-82 13:35")
                                                             (* from a list removes duplicates from the back, and 
							     changes the list)
                                                             (* RETURNs THE MODIFIED LIST)
    (PROG ((Ptr lis))
      LOOP(COND
	    ((NULL Ptr)
	      (RETURN lis)))
          [COND
	    ((FMEMB (CAR Ptr)
		    (CDR Ptr))
	      (RPLACD Ptr (DREMOVE (CAR Ptr)
				   (CDR Ptr]
          (SETQ Ptr (CDR Ptr))
          (GO LOOP])

(ObjectName
  [LAMBDA (x)                                                (* sm: "21-OCT-82 13:42")
                                                             (* returns the name of x, where x may be an object or 
							     object name)
    (PROG (obj)
          (SETQ obj (GetObjectRec x))
          (RETURN (COND
		    ((type? instance obj)
		      (GetValue obj (QUOTE name)))
		    (T (ClassName obj])

(PerformAltTest
  [LAMBDA (self type default TestedLst)                      (* sm: "20-SEP-83 16:32")
                                                             (* tries AltTest if any. otherwise returns default)
    (PROG (lis)
          (SETQ lis (GetValue self (QUOTE AltTest)))
          (COND
	    ((AND (NULL lis)
		  (NOT (AddAltTest self)))
	      (printout TTY " Not continuing with test.." T)
	      (RETURN default)))
          [COND
	    ((NOT (EQ (GetValue self (QUOTE AltTest)
				(QUOTE Tested?))
		      T))
	      (for x in lis do (SEND (GetObjectRec x)
				     TEST TestedLst))
	      (PutValue self (QUOTE AltTest)
			T
			(QUOTE Tested?]
          (RETURN (ExaminePreviousTry self])

(PerformSetup
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:33")
                                                             (* executes the SetUp of a testobj)
    (PROG (Sval Exp Res FMSG)
          (COND
	    ([ValueExists? (SETQ Res (GetValue self (QUOTE SetUp)
					       (QUOTE Tested?]
	      [COND
		((NULL Res)
		  (printout TTY 5 "Error in setting up the test environment." T)
		  (PrintFailedExp self (GetValue self (QUOTE SetUp)
						 (QUOTE FailedExp]
	      (RETURN Res)))
          (SETQ Exp (@ SetUp))
          [COND
	    ((NULL Exp)
	      (PrintIfLev LTMsgLev 2 (printout TTY "Sysnote: No SetUp expression for" -3
					       (@ name)
					       T]
          (SETQ Sval (EvaluateTest self (QUOTE SetUp)
				   NIL))
          (PutValue self (QUOTE SetUp)
		    (SETQ Res (COND
			((NULL Sval)
			  NIL)
			(T T)))
		    (QUOTE Tested?))
          [COND
	    ((NULL Res)
	      (ERRORSET (@ AfterTest)
			T)
	      (printout TTY 5 "Error in setting up the test environment." T)
	      (COND
		(FMSG (printout TTY "[Error in the following:" T)
		      (PutValue self (QUOTE SetUp)
				FMSG
				(QUOTE FailedExp))
		      (PrintFailedExp self FMSG]
          (RETURN Res])

(PerformTest
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:33")
                                                             (* actually tests the TestExpr of self)
    (PROG (Tval FMSG)                                        (* Globals: FMSG -
							     list of pairs for failed tests -
							     (Msgstring.Testexp))
          (SETQ Tval (EvaluateTest self (QUOTE TestExpr)
				   T))
          (COND
	    ((OR (NULL Tval)
		 (NULL (CAR Tval)))
	      (printout TTY "Test failed for.." (@ TestDesc)
			T 10 "Send bug report to LOOPSCORE↑.pa" T)
	      (COND
		(FMSG (printout TTY "[Following subtests failed:  " T)
		      (PutValue self (QUOTE TestExpr)
				FMSG
				(QUOTE FailedExp))
		      (PrintFailedExp self FMSG)))
	      (←@
		Tested?
		(TestErrorBreak self)))
	    (T (PrintIfLev LTMsgLev 7 (printout TTY "Test successful!! for.." (@ TestDesc)
						T))
	       (←@
		 Tested? T)))
          (RETURN (@ Tested?])

(PreTestsSatisfied?
  [LAMBDA (self TestedLst)                                   (* sm: "20-SEP-83 16:33")
                                                             (* checks the PreTests of a test and returns T, NIL or 
							     NotSetValue)
    (PROG NIL
          [COND
	    ((NOT (EQ (CheckClassTest self TestedLst)
		      T))
	      (PrintTestHeader self)
	      (printout TTY 5 "Following PreTest for this class failed:" -4 (@@ self ClassPreTest 
										Failed)
			T)
	      (RETURN (PerformAltTest self (QUOTE ClassPreTest)
				      NotSetValue TestedLst]
                                                             (* The class PreTest were successful so continue...)
          [COND
	    ((NOT (ValueNonNIL? (DoLoopsTest self (QUOTE PreTest)
					     (QUOTE TEST)
					     NIL TestedLst)))
	      (PrintTestHeader self)
	      (printout TTY 5 "Following pretests failed:" -4 (@ self PreTest Failed)
			T)
	      (RETURN (PerformAltTest self (QUOTE PreTest)
				      NotSetValue TestedLst]
                                                             (* PreTests were successful)
          (RETURN T])

(PrintFailedExp
  [LAMBDA (self FailedExp)                                   (* sm: "20-SEP-83 16:34")
                                                             (* prints the FailedExp of the type returned by 
							     EvaluateTest)
    [for x in FailedExp do (PROGN (printout TTY 1 "Comment:" 12 (CAR x))
				  (PrintIfLev LTELev 9 (printout TTY 1 "Code" 12 .PPF (CADR x)))
				  (PrintIfLev LTELev 8 (printout TTY 1 "Returned:" 12 (CADDR x]
    (printout TTY "]" T)
    FailedExp])

(PrintTestCode
  [LAMBDA (self)                                             (* sm: "20-SEP-83 16:34")
                                                             (* prints the Test Code fields, if type is TestObj else 
							     nothing)
    (PROG (TC)
          (SETQ TC (← self GetTestCode))
          [COND
	    (TC (printout TTY "Test Code for" -4 (ObjectName self)
			  T)
		(for x in TC do (printout TTY .PPFTL x T]
          (RETURN TC])

(PrintTestHeader
  [LAMBDA (self Msg)                                         (* sm: "20-SEP-83 16:34")
                                                             (* prints TestDesc header if global HeaderFlag is T.
							     Also sets the flag to NIL)
                                                             (* Msg is optional and "TESTING.."
							     by default)
    (COND
      (HeaderFlag (printout TTY (COND
			      ((NULL Msg)
				"TESTING..")
			      (T Msg))
			    -4
			    (@ TestDesc)
			    T)
		  (SETQ HeaderFlag NIL)
		  T)
      (T NIL])

(PushClassValueNew
  [LAMBDA (self var val prop)                                (* sm: " 5-OCT-82 12:29")
                                                             (* does PushClassValue only if val is already not on the
							     value list)
    (COND
      ((FMEMB val (GetClassValue self var prop)))
      (T (PushClassValue self var val prop)))
    val])

(PutInActVal
  [LAMBDA (self varName newValue propName activeVal type)    (* sm: "25-OCT-82 15:24")
                                                             (* This is a putFn for testing active values)
                                                             (* it just puts the value in)
    (PutLocalState activeVal newValue self varName propName type])

(ReadLinkMenu
  [LAMBDA (self link default AllOpt)                         (* sm: "21-OCT-82 14:21")

          (* asks the user to select one of the values of (self link). Returns the selected value or NIL.
	  If default is T, then if only one value is there, returns that as the selection, WITHOUT asking asking the user)

                                                             (* If AllOpt is T, then gives an ALL option, and returns
							     a list of selected names, even if all was not chosen)
    (PROG ((vals (GetValue self link))
	   Sel)
          (RETURN (COND
		    ((NULL vals)
		      NIL)
		    [(AND (EQ (LENGTH vals)
			      1)
			  default)
		      (COND
			(AllOpt vals)
			(T (CAR vals]
		    (T (SETQ Sel (MENU (create MENU
					       ITEMS ←(COND
						 (AllOpt (CONS (QUOTE ALL)
							       vals))
						 (T vals))
					       TITLE ← "Current Values")))
		       (COND
			 ((EQ Sel (QUOTE ALL))
			   vals)
			 ((NULL Sel)
			   NIL)
			 (AllOpt (CONS Sel))
			 (T Sel])

(ReasonNotDone
  [LAMBDA (self)                                             (* sm: "29-OCT-82 17:02")
                                                             (* given a TestObj, tries to generate a reason why test 
							     was not performed)
    (SETQ self (GetObjectRec self))
    (COND
      ((NULL (%@%@ ClassTested?))
	"ClassPreTest failed")
      ((NULL (%@ self PreTest Tested?))
	"PreTests failed")
      ((NULL (%@ self SetUp Tested?))
	"SetUp caused error")
      (T "Not tried or pretests were indeterminate"])

(RemoveValue
  [LAMBDA (self var val prop)                                (* sm: "11-OCT-82 17:52")
                                                             (* removes a value from var. will work only with var 
							     having the active value putFns MakeBackLink or 
							     AllowRemove)
    (PutValue self var (CONS (QUOTE -)
			     (MKLIST val))
	      prop])

(ResetLTKERCLASSES
  [LAMBDA NIL                                                (* sm: "30-MAR-83 11:18")
    (PutClassValue (%$ LOOPSTestMethod)
		   (QUOTE ClassTested?)
		   (QUOTE U))
    (PutClassValue (%$ LOOPSTestEnvironment)
		   (QUOTE ClassTested?)
		   (QUOTE U])

(ResetLTKERVARS
  [LAMBDA NIL                                                (* sm: "11-AUG-83 13:25")
    [SETQ Failed (SETQ NotDone (SETQ HasTest (SETQ Tested NIL]
    (SETQ EditTestWindows NIL)
    (SETQ LTAskNoTestAvailable NIL)
    (SETQ LTMsgLev (SETQ LTELev 8))
    (SETQ KBTestsFlg T])

(ResetPutLocalStateVars
  [LAMBDA NIL                                                (* sm: "29-NOV-82 18:07")
                                                             (* recreates the active values in LOOPSTestClass6 used 
							     by LTFPutLocalState)
    (PutValueOnly (%$ LOOPSTestClass6)
		  (QUOTE PLS1)
		  (create activeValue
			  localState ←(QUOTE LTC6)
			  getFn ← NIL
			  putFn ← NIL))
    (PutValueOnly (%$ LOOPSTestClass6)
		  (QUOTE PLS3)
		  (create activeValue
			  localState ←(create activeValue
					      localState ←(QUOTE LTC6)
					      getFn ←(QUOTE GetFromActVal)
					      putFn ←(QUOTE PutInActVal))
			  getFn ←(QUOTE GetFromActVal)
			  putFn ←(QUOTE PutInActVal])

(RunTest
  [LAMBDA (Seed)                                             (* sm: "16-NOV-82 13:43")
                                                             (* Runs test starting with objects in Seed)
    (PROG ((Tlis (CONS NIL))
	   Next Ptr Y (Tested (CONS NIL)))
          (LCONC Tlis (APPEND Seed))
          (SETQ Ptr (CAR Tlis))
      LOOP[COND
	    ((NULL Ptr)
	      (RETURN (CAR Tested]
          (SETQ Next (GetObjectRec (CAR Ptr)))
          (for x in (GetValue Next (QUOTE SubTest)) eachtime (SETQ Y (GetObjectRec x))
	     when (NOT (FMEMB Y (CAR Tlis))) do (TCONC Tlis Y))
          (for x in (GetValue Next (QUOTE PreTestOf)) eachtime (SETQ Y (GetObjectRec x))
	     when (NOT (FMEMB Y (CAR Tlis))) do (TCONC Tlis Y))
          (SETQ Ptr (CDR Ptr))
          [COND
	    ((NOT (FMEMB Next (CAR Tested)))
	      (TCONC Tested Next)
	      (ERSETQ (SEND Next TEST Tested]
          (GO LOOP])

(SetupEditTestObjMenu
  [LAMBDA NIL                                                (* sm: "29-MAR-83 16:10")
                                                             (* Sets up the menus for editing TestObjs)
                                                             (* returns the list of windows created)
    (LIST (TMenu (QUOTE ((PreTest (QUOTE PT)
				  "manipulate PreTest list" "
")
			  (SubTest (QUOTE SUB)
				   "manipulate SubTest list" "
")
			  (PreTestOf (QUOTE PTO)
				     "manipulate PreTestOf list" "
")
			  (UsesObj (QUOTE UO)
				   "manipulate UsesObj list" "
")
			  (CasesUsed (QUOTE CU)
				     "manipulate CasesUsed list" "
")
			  (SyntaxTest (QUOTE ST)
				      "manipulate SyntaxTest list" "
")
			  (AltTest (QUOTE AT)
				   "manipulate Alternate Test list" "
")
			  (OtherLinks (EditOtherLinksMenu)
				      "allows selection of less often used links" "
")))
		 "Test Links"
		 (QUOTE (645 20 150 150)))
	  (TMenu (QUOTE ((Dedit (QUOTE DEDIT)
				"Edit using Dedit" "
")
			  (PP (QUOTE PP)
			      "prettyprint this object" "
")
			  (Quit (QUOTE QUIT)
				"Quit this editing session" "
")
			  (Eval (QUOTE EVAL)
				"enter the USEREXEC" "
")
			  (Test (QUOTE TEST)
				"test the current object" "
")
			  (ReTest (QUOTE RETEST)
				  "retest the object, resetting it if needed" "
")
			  (WhoAmI (QUOTE WHO)
				  "tells you which object is being edited" "
")
			  (Describe (QUOTE DESCRIBE)
				    "describes the test object and state of any tests that were run" 
				    "
")
			  (Top (QUOTE TOP)
			       "go back to the very first object in this session" "
")
			  (Unremember (QUOTE UNREMEMBER)
				      "select (and pop) the last remembered object and edit it next" 
				      "
")
			  (Remember (QUOTE REMEMBER)
				    "save this object on the stack" "
")
			  (Select (QUOTE SELECT)
				  "asks for the next object to be edited (remembering current)" "
")
			  (Reset (QUOTE RESET)
				 "reset the test state of current object" "
")
			  (Execute (QUOTE EXEC)
				   "evaluate one of the selected Test fields" "
")
			  (TtyEdit (QUOTE VEDIT)
				   "Edit using TTYIN editor" "
")
			  (Others (EditTestOtherCmds)
				  "allows selection of less common commands" "
")))
		 "TestObj Edit Cmds"
		 (QUOTE (470 20 170 150)))
	  (TMenu (QUOTE ((Add NIL "enter the objects to be added" "
")
			  (Delete NIL "select the object to be deleted" "
")
			  (Select NIL "selected item will be edited next" " 
")
			  (Quit NIL "quit editing this link" "
")
			  (PP NIL "prettyprints the selected item" "
")
			  (Dedit NIL "edits selected object using DEDIT" "
")
			  (Desc NIL "describe the link values" "
")
			  (List NIL "displays the current list" "
")
			  (AddNum NIL "enter a number for new objects to be created" " 
")
			  (DefAdd NIL "add a new object to be defined by name" "
")
			  (TtyEdit (QUOTE VEDIT)
				   "edits selected object using screen editor" "
")
			  (Others (LinkEditOtherMenu)
				  "other commands" "
")))
		 "Link Edit Cmds"
		 (QUOTE (800 20 120 150])

(TestErrorBreak
  [LAMBDA (self)                                             (* sm: "27-OCT-82 16:46")
                                                             (* come here when TestExpr has error/NIL.
							     should return value that Tested? will be set to)
    NIL])

(TestObjectDesc
  [LAMBDA (self)                                             (* sm: "21-OCT-82 13:53")
                                                             (* returns the value of TestDesc IV if self has it, else
							     "")
    (COND
      ((SEND self HasIV (QUOTE TestDesc))
	(%@ TestDesc))
      (T ""])

(TickleBrowserNodes
  [LAMBDA (Objs Browser)                                     (* sm: "15-NOV-82 10:26")
                                                             (* given Browser with initial objects "Objs" Flips or 
							     Flashes these and other objects reachable via the link 
							     (s) given in the browser)
    (PROG [(Done (CONS))
	   (Nodes (CONS))
	   Ptr Next (Links (MKLIST (GetValue Browser (QUOTE subLinks]
          (LCONC Nodes (APPEND Objs))
          (SETQ Ptr (CAR Nodes))
      LOOP(SETQ Next (GetObjectRec (CAR Ptr)))
          (COND
	    ((MEMBER Next (CAR Done))
	      (GO LOOP2)))
          [COND
	    ((EQ (GetValue Next (QUOTE Tested?))
		 T)
	      (ERSETQ (← Browser FlipNode Next)))
	    ((OR (EQ (GetValue Next (QUOTE Tested?))
		     NIL)
		 (EQ (GetValue Next (QUOTE SetUp)
			       (QUOTE Tested?))
		     NIL))
	      (ERSETQ (← Browser FlashNode Next 5]
          [for x in Links do (LCONC Nodes (APPEND (GetValue Next x]
          (TCONC Done Next)
      LOOP2
          (SETQ Ptr (CDR Ptr))
          [COND
	    ((NULL Ptr)
	      (RETURN (CAR Done]
          (GO LOOP])
)

(RPAQQ LTKERINSTANCES NIL)

(RPAQQ LTKERMACROS (NotSetValue? PrintIfLev UnknownValue? ValueExists? ValueNonNIL?))
(DECLARE: EVAL@COMPILE 

(PUTPROPS NotSetValue? MACRO [LAMBDA (val)
			       (EQ val NotSetValue])

(PUTPROPS PrintIfLev MACRO [NLAMBDA (CLEV LEV EXP)           (* executes EXP if LEV>=CLEV)
			     (COND
			       ((GEQ (EVAL LEV)
				     (EVAL CLEV))
				 (EVAL EXP])

(PUTPROPS UnknownValue? MACRO [LAMBDA (val)
				(OR (EQ val NotSetValue)
				    (EQ val (QUOTE U])

(PUTPROPS ValueExists? MACRO [LAMBDA (val)                   (* Returns T iff val is not eq NotSetValue)
			       (AND (NOT (EQ val NotSetValue))
				    (NOT (EQ val (QUOTE U])

(PUTPROPS ValueNonNIL? MACRO [LAMBDA (val)                   (* Returns T iff val is NOT NIL and NOT EQ NotSetValue)
			       (AND val (NOT (EQ val (QUOTE U)))
				    (NOT (EQ val NotSetValue])
)

(RPAQQ LTKERVARS (AllTest CMN DUP EditTestWindows Failed HasTest KBTestsFlg LTAskNoTestAvailable 
			  LTELev LTMsgLev NotDone OMN Seed Tested))

(RPAQQ AllTest (LTTemplate LTDumpInstance LTLoadInstance LTMethod LTObject LTActiveValue LTKernel 
			   LTFSendSuper LTFGetInitialValue LTFPutNthValue LTFGetNthValue 
			   LTFGetObjectNames LTFtype? LTFClass LTFGetObjectRec LTFReplaceActiveValue 
			   LTFPutLocalState LTFGetLocalState LTFRenameMethodFunction LTFMoveMethod 
			   LTFMoveVariable LTFMoveClassVariable LTFRenameVariable LTFCalledFns 
			   LTFRenameMethod LTFTryMethod LTFDoMethod LTFPutItOnly LTFGetItOnly 
			   LTFPutIt LTFGetIt LTFPutMethodOnly LTFGetMethodOnly LTFPutMethod 
			   LTFGetMethod LTFPutClassOnly LTFGetClassOnly LTFPutClass LTFGetClass 
			   LTFPutClassValueOnly LTFPutValueOnly LTFPushClassValue LTFPutClassValue 
			   LTFAddValue LTFPushValue LTFGetClassValueOnly LTFGetValueOnly 
			   LTFGetClassValue LTFDM LTFDC LTFPutValue LTFGetValue LTFSend 
			   LTMTitleCommandInObj LTMSetNameInObj LTMRenameInObj LTMPutInObj 
			   LTMPPV!InObj LTMPP!InObj LTMPPInObj LTMList!InObj LTMListInObj 
			   LTMInspectValueCommandInObj LTMInspectTitleMenuInObj LTMInspectTitleInObj 
			   LTMInspectStoreInObj LTMInspectPropertiesInObj LTMInspectPropCommandInObj 
			   LTMInspectFetchInObj LTMHasIVInObj LTMEditInObj LTMDumpFactsInObj 
			   LTMDestroy!InObj LTMDestroyInObj LTMTitleCommandInClass LTMSetNameInClass 
			   LTMRenameInClass LTMPutInClass LTMPPV!InClass LTMPP!InClass LTMPPInClass 
			   LTMList!InClass LTMInspectValueCommandInClass LTMInspectTitleMenuInClass 
			   LTMInspectTitleInClass LTMInspectStoreInClass LTMInspectPropertiesInClass 
			   LTMInspectPropCommandInClass LTMInspectFetchInClass LTMHasIVInClass 
			   LTMEditInClass LTMDumpFactsInClass LTMDestroy!InClass LTMDestroyInClass 
			   LTMWhereIs LTMUnderstands LTMUnSetName LTMTraceIt LTMReturnDefaultValue 
			   LTMPutIVProp LTMPrintOn LTMNoObjectForMsg LTMMessageNotUnderstood 
			   LTMInstantiate LTMInstOf! LTMInstOf LTMInspect LTMIVMissing LTMDoMethod 
			   LTMDeleteIV LTMCopyShallow LTMCopyDeep LTMClassName LTMClass LTMBreakIt 
			   LTMAt LTMAssocKB LTMAddIV LTMSubClasses LTMReplaceSupers LTMPPMethod 
			   LTMPPM LTMOnFile LTMNewWithValues LTMNewTemp LTMNew LTMMoveMethod 
			   LTMMethodDoc LTMInitialize LTMHasCV LTMFetchMethod LTMEditMethod 
			   LTMDisplaySubClasses LTMDefMethod LTMCopyMethod LTMCommentMethods 
			   LTMDeleteInClass LTMAdd LTMListInClass LTEMapObjectNames LTECancel 
			   LTEMakeCurrent LTEThawKB LTEFreezeKB LTEAssocKB LTEDumpToKB LTESummarize 
			   LTEDelete LTECommunity LTEOld LTENew))

(RPAQQ CMN (Add CommentMethods CopyMethod DefMethod DisplaySubClasses EditMethod FetchMethod HasCV 
		Initialize MethodDoc MoveMethod New NewTemp NewWithValues OnFile PPM PPMethod 
		ReplaceSupers SubClasses))

(RPAQQ DUP (Destroy Destroy! DumpFacts Edit HasIV InspectFetch InspectPropCommand InspectProperties 
		    InspectStore InspectTitle InspectTitleMenu InspectValueCommand List List! PP PP! 
		    PPV! Put Rename SetName TitleCommand))

(RPAQQ EditTestWindows NIL)

(RPAQQ Failed NIL)

(RPAQQ HasTest NIL)

(RPAQQ KBTestsFlg T)

(RPAQQ LTAskNoTestAvailable NIL)

(RPAQQ LTELev 8)

(RPAQQ LTMsgLev 8)

(RPAQQ NotDone NIL)

(RPAQQ OMN (AddIV AssocKB At BreakIt Class ClassName CopyDeep CopyShallow DeleteIV DoMethod IVMissing 
		  Inspect InstOf InstOf! Instantiate MessageNotUnderstood NoObjectForMsg PrintOn 
		  PutIVProp ReturnDefaultValue TraceIt UnSetName Understands WhereIs))

(RPAQQ Seed (#&(LOOPSTestLispFunc "#(())") #&(LOOPSTestLispFunc "#(())") #&(LOOPSTestLispFunc "#(())")
 #&(LOOPSTestLispFunc "#(())") #&(LOOPSTestLispFunc "#(())") #&(LOOPSTestLispFunc "#(())") 
					   #&(LOOPSTestLispFunc "#(())")
					   #&(LOOPSTestLispFunc "#(())") #&(LOOPSTestLispFunc "#(())")
 #&(LOOPSTestLispFunc "#(())") #&(LOOPSTestLispFunc "#(())") #&(LOOPSTestLispFunc "#(())") 
					   #&(LOOPSTestLispFunc "#(())")
					   #&(LOOPSTestLispFunc "#(())") #&(LOOPSTestLispFunc "#(())")
					   ))

(RPAQQ Tested NIL)
(ResetLTKERCLASSES)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (21531 111571 (ATEST 21541 . 21652) (AddAltTest 21654 . 22072) (AllowRemove 22074 . 
22743) (AskPreTest 22745 . 24311) (AskSubTest 24313 . 26189) (AskSyntaxTest 26191 . 28127) (
AskTestCases 28129 . 29565) (BeginLoopsTest 29567 . 31743) (BuildPreTest 31745 . 32443) (
BuildPrimClassTest 32445 . 33101) (CheckClassTest 33103 . 34341) (CheckPreTest 34343 . 35412) (
CloseCurrentEnvironment 35414 . 35594) (CreateLTKBS1 35596 . 38351) (DescribePreviousTry 38353 . 39594
) (DescribeTestLink 39596 . 41409) (DisplayTestBrowser 41411 . 42762) (DoLoopsTest 42764 . 44387) (
DoTestSelf 44389 . 45870) (EQACTVAL 45872 . 46437) (EditOtherLinksMenu 46439 . 46866) (EditPreTest 
46868 . 50794) (EditTestOtherCmds 50796 . 51665) (EvaluateANDALLTest 51667 . 52883) (EvaluateANDTest 
52885 . 53881) (EvaluatePROGTest 53883 . 54867) (EvaluateTest 54869 . 56497) (ExaminePreviousTry 56499
 . 57196) (ExecTestFields 57198 . 57849) (FindObjForLink 57851 . 58443) (FlashTestBrowser 58445 . 
58937) (GIVGetFn 58939 . 59237) (GenerateTestList 59239 . 60582) (GetFromActVal 60584 . 61015) (
InformTestBrowser 61017 . 61767) (LOOPSTestEnvironment.TEST 61769 . 62215) (LOOPSTestObject.DefineTEST
 62217 . 63137) (LOOPSTestObject.Describe 63139 . 63626) (LOOPSTestObject.EditTEST 63628 . 66880) (
LOOPSTestObject.EditTestInTTYProcess 66882 . 67197) (LOOPSTestObject.GetTestCode 67199 . 67523) (
LOOPSTestObject.TEST 67525 . 68901) (LOOPSTestObject.TEST! 68903 . 71273) (LOOPSTestObject.TESTDep 
71275 . 72067) (LOOPSTestObject.TESTall 72069 . 72782) (LOOPSTestObject.TestSelf 72784 . 74286) (
LOOPSTestPrimitive.XTEST 74288 . 76444) (LinkEditOtherMenu 76446 . 77067) (
LOOPSTestMeta.BeginLOOPSTest 77069 . 80469) (LOOPSTestMeta.GetTestCode 80471 . 80703) (
LOOPSTestMeta.New 80705 . 81489) (LOOPSTestKernel.TEST 81491 . 84921) (LOOPSClassSuper.Destroy 84923
 . 85461) (LOOPSClassSuper.GetTestCode 85463 . 85718) (LOOPSTestObject.ReTest 85720 . 86200) (
LOOPSTestObject.ReTestDep 86202 . 86482) (LOOPSTestObject.Reset 86484 . 87261) (LOOPSTestObject.Reset!
 87263 . 88602) (LOOPSTestObject.ResetAll 88604 . 89984) (LOOPSTestObject.ResetDep 89986 . 91352) (
LOOPSTestObject.ResetSelf 91354 . 92507) (MakeBackLink 92509 . 94833) (MakeSet 94835 . 95426) (
ObjectName 95428 . 95856) (PerformAltTest 95858 . 96600) (PerformSetup 96602 . 97870) (PerformTest 
97872 . 98885) (PreTestsSatisfied? 98887 . 100067) (PrintFailedExp 100069 . 100602) (PrintTestCode 
100604 . 101091) (PrintTestHeader 101093 . 101689) (PushClassValueNew 101691 . 102070) (PutInActVal 
102072 . 102452) (ReadLinkMenu 102454 . 103489) (ReasonNotDone 103491 . 104036) (RemoveValue 104038 . 
104432) (ResetLTKERCLASSES 104434 . 104716) (ResetLTKERVARS 104718 . 105019) (ResetPutLocalStateVars 
105021 . 105754) (RunTest 105756 . 106712) (SetupEditTestObjMenu 106714 . 109781) (TestErrorBreak 
109783 . 110075) (TestObjectDesc 110077 . 110411) (TickleBrowserNodes 110413 . 111569)))))
STOP