Split off submodules

Testing/JUnitExport.dcl

+definition module Testing.JUnitExport
+
+from StdFile import class <<<
+from System.FilePath import :: FilePath
+
+from Testing.Util import :: RunResult
+
+:: JUnitExport =
+	{ jue_tests    :: !Int
+	, jue_failures :: !Int
+	, jue_suites   :: ![JUnitSuite]
+	, jue_time     :: !Int // in milliseconds
+	}
+
+:: JUnitSuite =
+	{ jus_id       :: !String
+	, jus_name     :: !String
+	, jus_tests    :: !Int
+	, jus_failures :: !Int
+	, jus_time     :: !Int // in milliseconds
+	, jus_cases    :: ![JUnitCase]
+	}
+
+:: JUnitCase =
+	{ juc_id       :: !String
+	, juc_name     :: !String
+	, juc_time     :: !Int // in milliseconds
+	, juc_failures :: ![JUnitFailure]
+	}
+
+:: JUnitFailure =
+	{ juf_file     :: !FilePath
+	, juf_line     :: !Int
+	, juf_category :: !String
+	, juf_message  :: !String
+	, juf_severity :: !String
+	}
+
+resultsToJUnitExport :: ![RunResult] -> JUnitExport
+
+instance <<< JUnitExport

Testing/JUnitExport.icl

+implementation module Testing.JUnitExport
+
+import StdEnv
+import StdMaybe
+
+import Data.Func
+import System.FilePath
+import Testing.Options
+import Testing.TestEvents
+from Text import class Text(lpad), instance Text String
+
+import Testing.Util
+
+resultsToJUnitExport :: ![RunResult] -> JUnitExport
+resultsToJUnitExport results
+# suites = map resultsToSuite results
+=
+	{ jue_tests    = sum [s.jus_tests \\ s <- suites]
+	, jue_failures = sum [s.jus_failures \\ s <- suites]
+	, jue_suites   = suites
+	, jue_time     = sum [s.jus_time \\ s <- suites]
+	}
+where
+	resultsToSuite :: !RunResult -> JUnitSuite
+	resultsToSuite res =
+		{ jus_id       = res.run.TestRun.name
+		, jus_name     = res.run.TestRun.name
+		, jus_tests    = max 1 (length res.RunResult.children)
+		, jus_failures = sum [1 \\ {event=Failed _} <- res.RunResult.children]
+		, jus_time     = 0 // TODO
+		, jus_cases    = map (eventToCase res.run.TestRun.name) res.RunResult.children
+		}
+
+	eventToCase :: !String !EndEvent -> JUnitCase
+	eventToCase suite_name event =
+		{ juc_id       = event.EndEvent.name
+		, juc_name     = event.EndEvent.name
+		, juc_time     = 0 // TODO
+		, juc_failures = case event.event of
+			Failed Nothing  -> [failure "unknown reason"]
+			Failed (Just r) -> [failure msg]
+				with
+					msg = case r of
+						FailedAssertions _ -> "failed assertions"
+						CounterExamples _  -> "counterexample(s)"
+						FailedChildren _   -> "failed child(ren) test(s)"
+						Crashed            -> "crashed"
+			_               -> []
+		}
+	where
+		failure msg =
+			{ juf_file     = suite_name // TODO
+			, juf_line     = 0 // TODO
+			, juf_category = "failed unit test"
+			, juf_message  = msg
+			, juf_severity = "ERROR"
+			}
+
+instance <<< JUnitExport
+where
+	<<< f jue
+	# f = f <<< "<?xml version=\"1.0\"?>\n"
+	# f = f <<< "<testsuites tests=\"" <<< jue.jue_tests
+		<<< "\" failures=\"" <<< jue.jue_failures
+		<<< "\" time=\"" <<< time jue.jue_time
+		<<< "\">\n"
+	# f = seqSt printTestSuite jue.jue_suites f
+	# f = f <<< "</testsuites>\n"
+	= f
+	where
+		time :: !Int -> String
+		time ms = toString (ms/1000) +++ "." +++ lpad (toString (ms rem 1000)) 3 '0'
+
+		printTestSuite :: !JUnitSuite !*File -> *File
+		printTestSuite jus f
+		# f = f <<< "\t<testsuite id=\"" <<< jus.jus_id
+			<<< "\" name=\"" <<< jus.jus_name
+			<<< "\" tests=\"" <<< jus.jus_tests
+			<<< "\" failures=\"" <<< jus.jus_failures
+			<<< "\" time=\"" <<< jus.jus_time
+			<<< "\">\n"
+		# f = seqSt printTestCase jus.jus_cases f
+		# f = f <<< "\t</testsuite>\n"
+		= f
+
+		printTestCase :: !JUnitCase !*File -> *File
+		printTestCase juc f
+		# f = f <<< "\t\t<testcase id=\"" <<< juc.juc_id
+			<<< "\" name=\"" <<< juc.juc_name
+			<<< "\" time=\"" <<< juc.juc_time
+			<<< "\">\n"
+		# f = seqSt printTestFailure juc.juc_failures f
+		# f = f <<< "\t\t</testcase>\n"
+		= f
+
+		printTestFailure :: !JUnitFailure !*File -> *File
+		printTestFailure juf f = f
+			<<< "\t\t\t<failure type=\"" <<< juf.juf_severity
+			<<< "\" message=\"" <<< juf.juf_file <<< ":" <<< juf.juf_line <<< " " <<< juf.juf_message
+			<<< "\">\n"
+			<<< juf.juf_severity <<< ": " <<< juf.juf_message <<< "\n"
+			<<< "Category: " <<< juf.juf_category <<< "\n"
+			<<< "File: " <<< juf.juf_file <<< "\n"
+			<<< "Line: " <<< juf.juf_line <<< "\n"
+			<<< "\t\t\t</failure>\n"

Testing/Util.dcl

+definition module Testing.Util
+
+from StdFile import class <<<
+from StdMaybe import :: Maybe
+
+from Testing.Options import :: TestRun
+from Testing.TestEvents import :: EndEvent, :: EndEventType
+from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode
+
+:: RunResult =
+	{ run      :: !TestRun
+	, result   :: !EndEventType
+	, children :: ![EndEvent]
+	}
+
+derive JSONEncode RunResult
+derive JSONDecode RunResult
+instance <<< RunResult
+
+readResults :: !*File -> *(!Maybe [RunResult], !*File)
+
+mergeResults :: ![RunResult] -> [RunResult]

Testing/Util.icl

+implementation module Testing.Util
+
+import StdEnv
+
+import Data.Func
+import Data.Functor
+import Data.List
+import Data.Maybe
+import Testing.Options
+import Testing.TestEvents
+import Text.GenJSON
+
+derive JSONEncode RunResult, TestRun, EndEventType
+derive JSONDecode RunResult, TestRun, EndEventType
+
+instance <<< RunResult where <<< f rr = f <<< toJSON rr <<< "\n"
+
+readResults :: !*File -> *(!Maybe [RunResult], !*File)
+readResults f
+# (e,f) = fend f
+| e = (Just [], f)
+# (l,f) = freadline f
+# rr = fromJSON $ fromString l
+| isNothing rr = (Nothing, f)
+# (rrs,f) = readResults f
+= ((\rrs -> [fromJust rr:rrs]) <$> rrs, f)
+
+mergeResults :: ![RunResult] -> [RunResult]
+mergeResults [] = []
+mergeResults [rr:rrs] = case partition (\rr` -> rr.run.TestRun.name == rr`.run.TestRun.name) rrs of
+	([], rrs)    -> [rr:mergeResults rrs]
+	([rr`], rrs) -> [{rr & result=merge rr.result rr`.result}:mergeResults rrs]
+where
+	merge :: !EndEventType !EndEventType -> EndEventType
+	merge (Failed (Just r1)) (Failed (Just r2)) = case (r1,r2) of
+		(FailedChildren cs1, FailedChildren cs2) -> Failed $ Just $ FailedChildren $ cs1 ++ cs2
+	merge (Failed r) _ = Failed r
+	merge _ (Failed r) = Failed r
+	merge Skipped _       = Skipped
+	merge _       Skipped = Skipped
+	merge Passed  Passed  = Passed

Util/ProcessOutput.dcl

+definition module Util.ProcessOutput
+
+:: *ProcessOutput =
+	{ lines :: ![String]
+	, rest  :: !String
+	}
+
+append :: !String !(String .e -> .e) !*ProcessOutput .e -> *(*ProcessOutput, .e)

Util/ProcessOutput.icl

+implementation module Util.ProcessOutput
+
+import StdEnv
+
+import Data.Func
+from Text import class Text(split), instance Text String
+
+append :: !String !(String .e -> .e) !*ProcessOutput .e -> *(*ProcessOutput, .e)
+append s f out env
+# out & rest = out.rest +++ s
+# lines = split "\n" out.rest
+| length lines == 1 = (out, env)
+# env = seqSt f (init lines) env
+# out & lines = out.lines ++ init lines
+# out & rest  = last lines
+= (out, env)

cleantest.icl

@@ -30,6 +30,10 @@ import Text.GenParse
 import Text.GenPrint
 import Text.Language
 
+import Testing.JUnitExport
+import Testing.Util
+import Util.ProcessOutput
+
 derive gDiff GenConsAssoc, Maybe, JSONNode
 derive gPrint Expression, JSONNode
 
@@ -90,21 +94,6 @@ simpleDiff left right
 	                   , {status=OnlyRight, value=right, children=[]}
 	                   ]
 
-:: *ProcessOutput =
-	{ lines :: ![String]
-	, rest  :: !String
-	}
-
-append :: !String !(String .e -> .e) !*ProcessOutput .e -> *(*ProcessOutput, .e)
-append s f out env
-# out & rest = out.rest +++ s
-# lines = split "\n" out.rest
-| length lines == 1 = (out, env)
-# env = seqSt f (init lines) env
-# out & lines = out.lines ++ init lines
-# out & rest  = last lines
-= (out, env)
-
 :: MessageType = MT_Started | MT_Passed | MT_Failed | MT_Skipped | MT_Lost
 :: OutputFormat = OF_HumanReadable | OF_JSON
 :: Strategy = S_Default | S_FailedFirst
@@ -118,42 +107,6 @@ messageType (EndEvent ee) = case ee.event of
 
 derive gEq MessageType; instance == MessageType where == a b = a === b
 
-:: RunResult =
-	{ run      :: !TestRun
-	, result   :: !EndEventType
-	, children :: ![EndEvent]
-	}
-
-mergeResults :: ![RunResult] -> [RunResult]
-mergeResults [] = []
-mergeResults [rr:rrs] = case partition (\rr` -> rr.run.TestRun.name == rr`.run.TestRun.name) rrs of
-	([], rrs)    -> [rr:mergeResults rrs]
-	([rr`], rrs) -> [{rr & result=merge rr.result rr`.result}:mergeResults rrs]
-where
-	merge :: !EndEventType !EndEventType -> EndEventType
-	merge (Failed (Just r1)) (Failed (Just r2)) = case (r1,r2) of
-		(FailedChildren cs1, FailedChildren cs2) -> Failed $ Just $ FailedChildren $ cs1 ++ cs2
-	merge (Failed r) _ = Failed r
-	merge _ (Failed r) = Failed r
-	merge Skipped _       = Skipped
-	merge _       Skipped = Skipped
-	merge Passed  Passed  = Passed
-
-derive JSONEncode RunResult, TestRun, EndEventType
-derive JSONDecode RunResult, TestRun, EndEventType
-
-instance <<< RunResult where <<< f rr = f <<< toJSON rr <<< "\n"
-
-readResults :: !*File -> *(!Maybe [RunResult], !*File)
-readResults f
-# (e,f) = fend f
-| e = (Just [], f)
-# (l,f) = freadline f
-# rr = fromJSON $ fromString l
-| isNothing rr = (Nothing, f)
-# (rrs,f) = readResults f
-= ((\rrs -> [fromJust rr:rrs]) <$> rrs, f)
-
 :: Options =
 	{ test_options          :: !TestOptions
 	, strategy              :: !Strategy
@@ -254,7 +207,7 @@ Start w
 		| not ok
 			# (_,w) = fclose (stderr <<< "Failed to open '" <<< junitf <<< "', skipping JUnit export\n") w
 			-> w
-		# f = outputJUnitExport rrs f
+		# f = f <<< resultsToJUnitExport rrs
 		# (_,w) = fclose f w
 		-> w
 = w
@@ -485,127 +438,3 @@ where
 		Failed _ -> setReturnCode 1 w
 		_        -> w
 	= ({run=r, result=eet, children=children}, w)
-
-:: JUnitExport =
-	{ jue_tests    :: !Int
-	, jue_failures :: !Int
-	, jue_suites   :: ![JUnitSuite]
-	, jue_time     :: !Int // in milliseconds
-	}
-
-:: JUnitSuite =
-	{ jus_id       :: !String
-	, jus_name     :: !String
-	, jus_tests    :: !Int
-	, jus_failures :: !Int
-	, jus_time     :: !Int // in milliseconds
-	, jus_cases    :: ![JUnitCase]
-	}
-
-:: JUnitCase =
-	{ juc_id       :: !String
-	, juc_name     :: !String
-	, juc_time     :: !Int // in milliseconds
-	, juc_failures :: ![JUnitFailure]
-	}
-
-:: JUnitFailure =
-	{ juf_file     :: !FilePath
-	, juf_line     :: !Int
-	, juf_category :: !String
-	, juf_message  :: !String
-	, juf_severity :: !String
-	}
-
-outputJUnitExport :: ![RunResult] !*File -> *File
-outputJUnitExport rrs f
-# f = f <<< "<?xml version=\"1.0\"?>\n"
-# jue = resultsToJUnitExport rrs
-# f = f <<< "<testsuites tests=\"" <<< jue.jue_tests
-	<<< "\" failures=\"" <<< jue.jue_failures
-	<<< "\" time=\"" <<< time jue.jue_time
-	<<< "\">\n"
-# f = seqSt printTestSuite jue.jue_suites f
-# f = f <<< "</testsuites>\n"
-= f
-where
-	time :: !Int -> String
-	time ms = toString (ms/1000) +++ "." +++ lpad (toString (ms rem 1000)) 3 '0'
-
-	printTestSuite :: !JUnitSuite !*File -> *File
-	printTestSuite jus f
-	# f = f <<< "\t<testsuite id=\"" <<< jus.jus_id
-		<<< "\" name=\"" <<< jus.jus_name
-		<<< "\" tests=\"" <<< jus.jus_tests
-		<<< "\" failures=\"" <<< jus.jus_failures
-		<<< "\" time=\"" <<< jus.jus_time
-		<<< "\">\n"
-	# f = seqSt printTestCase jus.jus_cases f
-	# f = f <<< "\t</testsuite>\n"
-	= f
-
-	printTestCase :: !JUnitCase !*File -> *File
-	printTestCase juc f
-	# f = f <<< "\t\t<testcase id=\"" <<< juc.juc_id
-		<<< "\" name=\"" <<< juc.juc_name
-		<<< "\" time=\"" <<< juc.juc_time
-		<<< "\">\n"
-	# f = seqSt printTestFailure juc.juc_failures f
-	# f = f <<< "\t\t</testcase>\n"
-	= f
-
-	printTestFailure :: !JUnitFailure !*File -> *File
-	printTestFailure juf f = f
-		<<< "\t\t\t<failure type=\"" <<< juf.juf_severity
-		<<< "\" message=\"" <<< juf.juf_file <<< ":" <<< juf.juf_line <<< " " <<< juf.juf_message
-		<<< "\">\n"
-		<<< juf.juf_severity <<< ": " <<< juf.juf_message <<< "\n"
-		<<< "Category: " <<< juf.juf_category <<< "\n"
-		<<< "File: " <<< juf.juf_file <<< "\n"
-		<<< "Line: " <<< juf.juf_line <<< "\n"
-		<<< "\t\t\t</failure>\n"
-
-resultsToJUnitExport :: ![RunResult] -> JUnitExport
-resultsToJUnitExport results
-# suites = map resultsToSuite results
-=
-	{ jue_tests    = sum [s.jus_tests \\ s <- suites]
-	, jue_failures = sum [s.jus_failures \\ s <- suites]
-	, jue_suites   = suites
-	, jue_time     = sum [s.jus_time \\ s <- suites]
-	}
-where
-	resultsToSuite :: !RunResult -> JUnitSuite
-	resultsToSuite res =
-		{ jus_id       = res.run.TestRun.name
-		, jus_name     = res.run.TestRun.name
-		, jus_tests    = max 1 (length res.RunResult.children)
-		, jus_failures = sum [1 \\ {event=Failed _} <- res.RunResult.children]
-		, jus_time     = 0 // TODO
-		, jus_cases    = map (eventToCase res.run.TestRun.name) res.RunResult.children
-		}
-
-	eventToCase :: !String !EndEvent -> JUnitCase
-	eventToCase suite_name event =
-		{ juc_id       = event.EndEvent.name
-		, juc_name     = event.EndEvent.name
-		, juc_time     = 0 // TODO
-		, juc_failures = case event.event of
-			Failed Nothing  -> [failure "unknown reason"]
-			Failed (Just r) -> [failure msg]
-				with
-					msg = case r of
-						FailedAssertions _ -> "failed assertions"
-						CounterExamples _  -> "counterexample(s)"
-						FailedChildren _   -> "failed child(ren) test(s)"
-						Crashed            -> "crashed"
-			_               -> []
-		}
-	where
-		failure msg =
-			{ juf_file     = suite_name // TODO
-			, juf_line     = 0 // TODO
-			, juf_category = "failed unit test"
-			, juf_message  = msg
-			, juf_severity = "ERROR"
-			}