JUnitExport.icl 4.93 KB
Newer Older
Camil Staps's avatar
Camil Staps committed
1 2 3 4 5
implementation module Testing.JUnitExport

import StdEnv

import Data.Func
Camil Staps's avatar
Camil Staps committed
6
import Control.Monad
7 8
import Data.GenDiff
import Data.Maybe
Camil Staps's avatar
Camil Staps committed
9 10 11
import System.FilePath
import Testing.Options
import Testing.TestEvents
Camil Staps's avatar
Camil Staps committed
12 13
import qualified Text
from Text import class Text, instance Text String
Camil Staps's avatar
Camil Staps committed
14
import Text.HTML
15
import Text.Language
Camil Staps's avatar
Camil Staps committed
16 17 18 19 20 21 22 23 24 25 26 27 28 29 30

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 =
31 32 33 34 35
		{ 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.RunResult.children
Camil Staps's avatar
Camil Staps committed
36 37
		}

38 39 40 41
	eventToCase :: !EndEvent -> JUnitCase
	eventToCase event =
		{ juc_id        = event.EndEvent.name
		, juc_name      = event.EndEvent.name
Camil Staps's avatar
Camil Staps committed
42
		, juc_classname = fromMaybe "unknown module" $ (\l -> l.moduleName) =<< event.EndEvent.location
43 44 45 46 47
		, juc_time      = 0 // TODO
		, juc_failure   = case event.event of
			Failed Nothing  -> Just "unknown reason"
			Failed (Just r) -> Just (toString r)
			_               -> Nothing
Camil Staps's avatar
Camil Staps committed
48
		}
49 50 51 52 53

instance toString FailReason
where
	toString r = case r of
		FailedAssertions fas
Camil Staps's avatar
Camil Staps committed
54
			-> pluralisen English (length fas) "Failed assertion" +++ ":\n\n" +++ 'Text'.join "\n\n" [toString fa \\ fa <- fas]
55
		CounterExamples ces
Camil Staps's avatar
Camil Staps committed
56
			-> pluralisen English (length ces) "Counterexample" +++ ":\n\n" +++ 'Text'.join "\n\n" [toString ce \\ ce <- ces]
57
		FailedChildren fcs
Camil Staps's avatar
Camil Staps committed
58
			-> pluralisen English (length fcs) "Failed child test" +++ ":\n- " +++ 'Text'.join "\n- "
59 60 61 62 63 64 65 66 67 68
				[name +++ ": " +++ short reason \\ (name,reason) <- fcs]
			with
				short Nothing = "no reason given"
				short (Just r) = case r of
					FailedAssertions fas -> pluralisen English (length fas) "failed assertion"
					CounterExamples ces  -> pluralisen English (length ces) "counterexample"
					FailedChildren fcs   -> pluralisen English (length fcs) "failed child test"
					Crashed              -> "crashed"
		Crashed
			-> "Crashed"
69 70
		CustomFailReason reason
			-> reason
71 72 73 74 75 76 77 78 79

instance toString FailedAssertion
where
	toString (ExpectedRelation a r b) = "\tExpected " +++ toString r +++ " on:\n" +++
		"\t- " +++ toString a +++ "\n" +++
		"\t- " +++ toString b +++
		case r of
			Eq -> "\n\tDiff:\n\t" +++ cleanDiff (diffToConsole (gDiff{|*|} a b))
			_  -> ""
Camil Staps's avatar
Camil Staps committed
80
	where
81 82
		cleanDiff =
			// Add indent
Camil Staps's avatar
Camil Staps committed
83
			'Text'.replaceSubString "\n" "\n\t" o
84 85 86 87 88
			// remove < and > because they are treated specially in XML
			(\s -> case s.[0] of
				'<' -> {if (i==0) '-' c \\ c <-: s & i <- [0..]}
				'>' -> {if (i==0) '+' c \\ c <-: s & i <- [0..]}
				_   -> s) o
Camil Staps's avatar
Camil Staps committed
89 90
			'Text'.replaceSubString "\n<" "\n-" o
			'Text'.replaceSubString "\n>" "\n+" o
91
			// remove ANSI colours because we're not printing to the console
Camil Staps's avatar
Camil Staps committed
92 93 94 95
			'Text'.replaceSubString "\033[0m" "" o
			'Text'.replaceSubString "\033[0;33m" "" o
			'Text'.replaceSubString "\033[0;32m" "" o
			'Text'.replaceSubString "\033[0;31m" ""
96 97 98 99

instance toString CounterExample
where
	toString ce = "Arguments:\n\t" +++
Camil Staps's avatar
Camil Staps committed
100
		'Text'.join "\n\t" [toString arg \\ arg <- ce.counterExample] +++
101 102 103
		case ce.failedAssertions of
			[]  -> ""
			fas -> "\n" +++ pluralisen English (length fas) "Failed assertion" +++ ":\n" +++
Camil Staps's avatar
Camil Staps committed
104
				'Text'.join "\n" ['Text'.replaceSubString "\n\t" "\n\t\t" (toString fa) \\ fa <- fas]
Camil Staps's avatar
Camil Staps committed
105 106 107 108 109 110 111 112 113 114 115 116 117 118

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
Camil Staps's avatar
Camil Staps committed
119
		time ms = toString (ms/1000) +++ "." +++ 'Text'.lpad (toString (ms rem 1000)) 3 '0'
Camil Staps's avatar
Camil Staps committed
120 121 122

		printTestSuite :: !JUnitSuite !*File -> *File
		printTestSuite jus f
Camil Staps's avatar
Camil Staps committed
123
		# f = f <<< "\t<testsuite name=\"" <<< escapeStr jus.jus_name
Camil Staps's avatar
Camil Staps committed
124 125
			<<< "\" tests=\"" <<< jus.jus_tests
			<<< "\" failures=\"" <<< jus.jus_failures
126
			<<< "\" time=\"" <<< time jus.jus_time
Camil Staps's avatar
Camil Staps committed
127 128 129 130 131
			<<< "\">\n"
		# f = seqSt printTestCase jus.jus_cases f
		# f = f <<< "\t</testsuite>\n"
		= f

132
		printProperty :: !(!String,!String) !*File -> *File
Camil Staps's avatar
Camil Staps committed
133 134 135
		printProperty (key,val) f = f <<< "\t\t\t<property name=\"" <<< escapeStr key
			<<< "\" value=\"" <<< escapeStr val
			<<< "\"?>\n"
136

Camil Staps's avatar
Camil Staps committed
137 138
		printTestCase :: !JUnitCase !*File -> *File
		printTestCase juc f
Camil Staps's avatar
Camil Staps committed
139 140 141
		# f = f <<< "\t\t<testcase id=\"" <<< escapeStr juc.juc_id
			<<< "\" name=\"" <<< escapeStr juc.juc_name
			<<< "\" classname=\"" <<< escapeStr juc.juc_classname
142 143 144 145
			<<< "\" time=\"" <<< time juc.juc_time
			<<< "\">"
		# f = case juc.juc_failure of
			Nothing -> f
Camil Staps's avatar
Camil Staps committed
146
			Just r  -> f <<< "\n\t\t\t<failure>" <<< escapeStr r <<< "</failure>\n\t\t"
147
		# f = f <<< "</testcase>\n"
Camil Staps's avatar
Camil Staps committed
148
		= f