Updated codequality monitor tool to compile and run clean-test based unit tests

Libraries/iTasks/Extensions/Development/Testing.dcl

@@ -4,8 +4,9 @@ definition module iTasks.Extensions.Development.Testing
 */
 import iTasks
 
-from Testing.TestEvents import :: EndEventType
+from Testing.TestEvents import :: EndEvent, :: EndEventType
 from iTasks.Util.Testing import :: TestReport 
+from iTasks.Extensions.Development.Codebase import :: CleanModuleName, :: ModuleName
 
-compileTestModule :: FilePath -> Task EndEventType
-runTestModule :: FilePath -> Task EndEventType
+compileTestModule :: CleanModuleName -> Task EndEvent
+runTestModule :: CleanModuleName -> Task [EndEvent]

Libraries/iTasks/Extensions/Development/Testing.icl

@@ -4,78 +4,57 @@ import System.Time
 
 import Testing.TestEvents 
 import iTasks.Util.Testing 
+import iTasks.Extensions.Files
 import iTasks.Extensions.Development.Tools
-import Text, Data.Tuple, Data.Error, System.FilePath, System.OS
+import iTasks.Extensions.Development.Codebase
+import Text, Data.Tuple, Data.Error, Data.Func, System.FilePath, System.OS
 
-TESTS_PATH :== "../Tests/TestPrograms"
-
-//:: CompileError = CompileError !Int
 derive class iTask EndEventType
-derive gEditor FailReason, FailedAssertion, CounterExample, Relation
-derive gText FailReason, FailedAssertion, CounterExample, Relation
-derive gDefault FailReason, FailedAssertion, CounterExample, Relation
-derive gEq FailReason, FailedAssertion, CounterExample, Relation
-
-compileTestModule :: FilePath -> Task EndEventType
-compileTestModule path
-	= 	traceValue path >>| get cpmExecutable
-	>>- \cpm ->runWithOutput cpm ["project", base, "create"] (Just baseDir)
-	>>- \_   ->runWithOutput cpm ["project", prj, "target", "iTasks"] (Just baseDir)
-	>>- \_   ->runWithOutput cpm ["project", prj, "exec", base +++ ".exe"] (Just baseDir)
-	>>- \_   ->runWithOutput cpm ["project", prj, "set", "-h", "200M", "-s", "2M", "-dynamics"] (Just baseDir)
-	>>- \_   ->runWithOutput cpm [prj] (Just baseDir) //Build the test
-		@ \(c,o) -> if (passed c o) Passed (Failed Nothing)
+derive gEditor EndEvent, FailReason, FailedAssertion, CounterExample, Relation
+derive gText EndEvent, FailReason, FailedAssertion, CounterExample, Relation
+derive gDefault EndEvent, FailReason, FailedAssertion, CounterExample, Relation
+derive gEq EndEvent, FailReason, FailedAssertion, CounterExample, Relation
+
+compileTestModule :: CleanModuleName -> Task EndEvent
+compileTestModule (path,name)
+	=           copyFile prjDefaultPath prjPath
+	>>- \_   -> get cpmExecutable
+	>>- \cpm -> runWithOutput cpm [prjPath] Nothing //Build the test
+	@   \(c,o) -> if (passed c o) 
+			{name = testName, event = Passed, message = join "" o}
+			{name = testName, event = (Failed Nothing), message = join "" o}
 where
+	testName = "Compile: " +++ name
+	iclPath = cleanFilePath (path,name,Icl)
+	prjDefaultPath = path </> name +++ ".prj.default"
+	prjPath = path </> name +++ ".prj"
+
     //Cpm still returns exitcode 0 on failure, so we have to check the output
 	passed 0 o = let lines = split OS_NEWLINE (join "" o) in not (any isErrorLine lines) 
 	passed _ _ = False
 
  	isErrorLine l = startsWith "Error" l || startsWith "Type error" l || startsWith "Parse error" l
 
-	baseDir = takeDirectory path
-	base = takeFileName (dropExtension path)
-	prj = takeFileName (addExtension base "prj")
-
 //Copy-paste.. should be in library
-runTestModule :: FilePath -> Task EndEventType
-runTestModule path
-	= compileTestModule path
-	>>- \res -> case res of
-		Passed = runWithOutput exe [] Nothing @ (parseSuiteResult o appSnd (join "")) //Run the test
-	    _      = return res
+runTestModule :: CleanModuleName -> Task [EndEvent]
+runTestModule (path,name)
+	=   compileTestModule (path,name)
+	>>- \res=:{EndEvent|event} -> case event of
+		Passed = runWithOutput exe [] Nothing @ (parseTestResults o appSnd (join "")) //Run the test
+	    _      = return [res]
 where
+	exe = IF_WINDOWS (base </> addExtension name "exe") (path </> name)
 	baseDir = takeDirectory path
 	base = dropExtension path
-	exe = addExtension base "exe"
 
-	parseSuiteResult :: (Int,String) -> EndEventType //QUICK AND DIRTY PARSER
-	parseSuiteResult (ecode,output)
-		# lines = split "\n" output
+	parseTestResults (ecode,output)
+		# lines = split OS_NEWLINE output
 		| length lines < 2 = fallback ecode output
-		# suiteName = trim ((split ":" (lines !! 0)) !! 1)
-		# results = [parseRes resLines \\ resLines <- splitLines (drop 3 lines) | length resLines >= 2]
-		= Passed 
-		//= {SuiteResult|suiteName=suiteName,testResults=results}
+		= [res \\ Just res <- map (fromJSON o fromString) lines]		
 	where
-		splitLines lines = split` lines [[]]
-		where
-			split` ["":lines] acc = split` lines [[]:acc]
-			split` [l:lines] [h:acc] = split` lines [[l:h]:acc]
-			split` [] acc = reverse (map reverse acc)
-
-		parseRes [nameLine,resultLine:descLines]
-			# name = trim ((split ":" nameLine) !! 1)
-			# result = case resultLine of
-				"Result: Passed" = Passed
-				"Result: Skipped" = Skipped
-				//_ = Failed (if (descLines =: []) Nothing (Just (join "\n" descLines)))
-				_ = Failed (if (descLines =: []) Nothing (Just Crashed))
-			= (name,result)
-		parseRes _ = ("oops",Failed Nothing)
-
 		//If we can't parse the output, We'll treat it as a single simple test executable
-		fallback 0 _ = Passed //{SuiteResult|suiteName="Unknown",testResults=[("executable",Passed)]}
-		fallback _ output = Failed Nothing//{SuiteResult|suiteName="Unknown",testResults=[("executable",Failed (Just output))]}
+		fallback 0 _ = [{name=name,event=Passed,message="Execution returned 0"}]
+		fallback _ output = [{name=name,event=Failed Nothing,message=output}]
 
 runWithOutput :: FilePath [String] (Maybe FilePath) -> Task (Int,[String])
 runWithOutput prog args dir = withShared ([], []) \out->withShared [] \stdin->

Tools/CodeQualityMonitor.icl

@@ -38,17 +38,17 @@ EXAMPLE_MODULES :== ["../Examples/BasicApiExamples.icl"
 
 derive class iTask EndEventType
 
-derive gEditor FailReason, FailedAssertion, CounterExample, Relation
-derive gDefault FailReason, FailedAssertion, CounterExample, Relation
-derive gEq FailReason, FailedAssertion, CounterExample, Relation
-derive gText FailReason, FailedAssertion, CounterExample, Relation
+derive gEditor EndEvent, FailReason, FailedAssertion, CounterExample, Relation
+derive gDefault EndEvent, FailReason, FailedAssertion, CounterExample, Relation
+derive gEq EndEvent, FailReason, FailedAssertion, CounterExample, Relation
+derive gText EndEvent, FailReason, FailedAssertion, CounterExample, Relation
 
 inspectCodeQuality :: Task ()
 inspectCodeQuality
 	= application {WebImage|src="/testbench.png",alt="iTasks Testbench",width=200, height=50}
     	( allTasks [Title "Unit Tests"           @>> runUnitTests 
 				   ,Title "Interactive Tests"    @>> runInteractiveTests 
-				   ,Title "Example applications" @>> checkExampleApplications
+				 //,Title "Example applications" @>> checkExampleApplications
 				   ,Title "Code"                 @>> exploreCode 
                    ,Title "Experiment"           @>> inspectMainModule "test" "module test\nStart = \"Hello World\""
 				   ] <<@ ArrangeWithTabs False
@@ -59,12 +59,12 @@ where
 
 runInteractiveTests :: Task ()
 runInteractiveTests
-	= (     editSelectionWithShared (Title "Select test") False (SelectInTree collectionToTree selectTest) tests (const []) @? tvHd
+	= (     editSelectionWithShared (Title "Select test") False (SelectInTree fileCollectionToTree selectTest) tests (const []) @? tvHd
 		>&> withSelection (viewInformation () [] "Select a test") testInteractive ) <<@ ArrangeWithSideBar 0 LeftSide 250 True @! ()
 where
 	tests = sdsFocus INTERACTIVE_TESTS_PATH (fileCollection (\path isDirectory -> isDirectory || takeExtension path == "icl") False)
 
-	collectionToTree collection = itemsToTree [] collection
+	fileCollectionToTree collection = itemsToTree [] collection
 	where
 		itemsToTree prefix subCollection = map (itemToTree prefix) ('DM'.toList subCollection)
 
@@ -88,38 +88,42 @@ where
 runUnitTests :: Task ()
 runUnitTests = withShared 'DM'.newMap
 	\results ->
-		(
-		 (enterChoiceWithSharedAs () [ChooseFromGrid fst] (testsWithResults results) fst 
-		>&> withSelection (viewInformation "Select a test" [] ())
-			(\path -> 
-				(viewSharedInformation (Title "Code") [ViewUsing id aceTextArea] (sdsFocus (UNIT_TESTS_PATH </> path) (removeMaybe Nothing fileShare))
-				-&&-
-				viewSharedInformation (Title "Results") [ViewAs (toTestReport o maybeToList)] (mapRead ('DM'.get path) results) <<@ ArrangeHorizontal)
+	 ((    ((editSelectionWithShared (Title "Tests") False
+				(SelectInTree toModuleSelectTree selectByIndex)
+				(sdsFocus UNIT_TESTS_PATH moduleList) (const []) @? tvHd)
+			)
+		   >&> withSelection (viewInformation "Select a test" [] ())
+                             (viewTest results)
+          )
+		@! ()) <<@ ArrangeWithSideBar 0 LeftSide 250 True
+where
+	selectByIndex nodes indices = [nodes !! i \\ i <- indices | i >= 0 && i < length nodes]
+
+	viewTest results (name,_)
+		= (viewSharedInformation (Title "Code") [ViewUsing (join "\n") aceTextArea] (sdsFocus (UNIT_TESTS_PATH,name) moduleImplementation)
+		-&&-
+		  ((viewSharedInformation (Title "Results") [ViewAs (toTestReport o maybeToList)] (mapRead ('DM'.get name) results) <<@ ArrangeHorizontal)
 				>^* [OnAction (Action "Run") (always
-						(		runTestModule (UNIT_TESTS_PATH </> path) <<@ InWindow
-							>>- \res -> (upd ('DM'.put path res)) results
+						(		runTestModule (UNIT_TESTS_PATH,name) <<@ InWindow
+							>>- \res -> (upd ('DM'.put name res)) results
 						)
 					)]
-			) @! ()) <<@ ArrangeWithSideBar 0 LeftSide 250 True
-		)		
-where
-	testsWithResults results = mapRead (\(res,tests) -> [(t,'DM'.get t res) \\t <- tests]) (results |*| tests)
-	where
- 		tests = mapRead (filter ((==) "icl" o takeExtension)) (sdsFocus UNIT_TESTS_PATH directoryListing)
+		) @! ()) <<@ ArrangeWithSideBar 1 RightSide 400 True
 
 	toTestReport results
-		= DivTag [] [] //[suiteHtml res \\ res <- results | not (isEmpty results)]
+		= DivTag [] [setHtml res \\ res <- results | not (isEmpty results)]
 	where
-		suiteHtml testResults
+		setHtml testResults
 			= TableTag [StyleAttr "width: 100%"] [headerRow:map resultRow testResults]
 
 		headerRow = TrTag [] [ThTag [] [Text "Test"],ThTag [] [Text "Result"],ThTag [] [Text "Details"]]
 
-		resultRow Passed = TrTag [] [TdTag [] [Text "FIXME"],TdTag [] [SpanTag [StyleAttr "color: green"] [Text "Passed"]],TdTag [] []]
-		resultRow Skipped = TrTag [] [TdTag [] [Text "FIXME"],TdTag [] [SpanTag [StyleAttr "color: orange"] [Text "Skipped"]],TdTag [] []]
-		resultRow (Failed Nothing) = TrTag [] [TdTag [] [Text "FIXME"],TdTag [] [SpanTag [StyleAttr "color: red"] [Text "Failed"]],TdTag [] []]
-		resultRow (Failed (Just details)) = TrTag [] [TdTag [] [Text "FIXME"],TdTag [] [SpanTag [StyleAttr "color: red"] [Text "Failed"]],TdTag [] [TextareaTag [] [Text (toString (toJSON details))]]]
+		resultRow {name,event=Passed,message} = TrTag [] [TdTag [] [Text name],TdTag [] [SpanTag [StyleAttr "color: green"] [Text "Passed"]],TdTag [] [Text message]]
+		resultRow {name,event=Skipped,message} = TrTag [] [TdTag [] [Text name],TdTag [] [SpanTag [StyleAttr "color: orange"] [Text "Skipped"]],TdTag [] [Text message]]
+		resultRow {name,event=Failed Nothing,message} = TrTag [] [TdTag [] [Text name],TdTag [] [SpanTag [StyleAttr "color: red"] [Text "Failed"]],TdTag [] [Text message]]
+		resultRow {name,event=Failed (Just details),message} = TrTag [] [TdTag [] [Text name],TdTag [] [SpanTag [StyleAttr "color: red"] [Text "Failed"]],TdTag [] [TextareaTag [] [Text (toString (toJSON details))]]]
 
+/*
 checkExampleApplications = withShared 'DM'.newMap
 	\results ->
 		(
@@ -140,6 +144,7 @@ where
 	examplesWithResults results = mapRead (\(res,examples) -> [(e,'DM'.get e res) \\e <- examples ]) (results |*| examples)
 	where
 		examples = constShare EXAMPLE_MODULES
+*/
 
 exploreCode :: Task ()
 exploreCode 
@@ -293,7 +298,6 @@ where
                    ]
 
 Start world = startEngine inspectCodeQuality world
-//Start world = startEngineWithOptions (\cli options -> (Just {options & autoLayout = False},[])) inspectCodeQuality world
 
 //CREATE THIS WITH CPM LIBRARY
 projectTemplate moduleName = join OS_NEWLINE

Tools/CodeQualityMonitor.prj.default

@@ -8,7 +8,7 @@ Global
 		CheckIndexes:	True
 	Application
 		HeapSize:	209715200
-		StackSize:	512000
+		StackSize:	5120000
 		ExtraMemory:	8192
 		IntialHeapSize:	204800
 		HeapSizeMultiplier:	4096