Permalink
Browse files

Merge branch 'master' of github.com:batterseapower/test-framework

  • Loading branch information...
2 parents ba09f9c + dcb27aa commit 9c3126cd08ff2461e4b99626d36a4fb5973bd989 @batterseapower committed Jan 27, 2012
@@ -71,8 +71,11 @@ optionsDescription = [
(NoArg (mempty { ropt_xml_nested = Just True }))
"use nested testsuites to represent groups in JUnit XML (not standards compliant)",
Option [] ["plain"]
- (NoArg (mempty { ropt_plain_output = Just True }))
+ (NoArg (mempty { ropt_color_mode = Just ColorNever }))
"do not use any ANSI terminal features to display the test run",
+ Option [] ["color"]
+ (NoArg (mempty { ropt_color_mode = Just ColorAlways }))
+ "use ANSI terminal features to display the test run",
Option [] ["hide-successes"]
(NoArg (mempty { ropt_hide_successes = Just True }))
"hide sucessful tests, and only show failures"
@@ -123,9 +126,14 @@ defaultMainWithOpts tests ropts = do
-- Get a lazy list of the test results, as executed in parallel
running_tests <- runTests ropts' tests
-
+
+ isplain <- case unK $ ropt_color_mode ropts' of
+ ColorAuto -> not `fmap` hIsTerminalDevice stdout
+ ColorNever -> return True
+ ColorAlways -> return False
+
-- Show those test results to the user as we get them
- fin_tests <- showRunTestsTop (unK $ ropt_plain_output ropts') (unK $ ropt_hide_successes ropts') running_tests
+ fin_tests <- showRunTestsTop isplain (unK $ ropt_hide_successes ropts') running_tests
let test_statistics' = gatherStatistics fin_tests
-- Output XML report (if requested)
@@ -146,6 +154,6 @@ completeRunnerOptions ro = RunnerOptions {
ropt_test_patterns = K $ ropt_test_patterns ro `orElse` mempty,
ropt_xml_output = K $ ropt_xml_output ro `orElse` Nothing,
ropt_xml_nested = K $ ropt_xml_nested ro `orElse` False,
- ropt_plain_output = K $ ropt_plain_output ro `orElse` False,
+ ropt_color_mode = K $ ropt_color_mode ro `orElse` ColorAuto,
ropt_hide_successes = K $ ropt_hide_successes ro `orElse` False
}
@@ -18,7 +18,7 @@ import System.IO
import Text.PrettyPrint.ANSI.Leijen
-import Data.Monoid
+import Data.Monoid (mempty)
import Control.Arrow (second, (&&&))
import Control.Monad (unless)
@@ -6,6 +6,7 @@ import Test.Framework.Runners.TestPattern
import Data.Monoid
+data ColorMode = ColorAuto | ColorNever | ColorAlways
type RunnerOptions = RunnerOptions' Maybe
type CompleteRunnerOptions = RunnerOptions' K
@@ -15,7 +16,7 @@ data RunnerOptions' f = RunnerOptions {
ropt_test_patterns :: f [TestPattern],
ropt_xml_output :: f (Maybe FilePath),
ropt_xml_nested :: f Bool,
- ropt_plain_output :: f Bool,
+ ropt_color_mode :: f ColorMode,
ropt_hide_successes :: f Bool
}
@@ -26,7 +27,7 @@ instance Monoid (RunnerOptions' Maybe) where
ropt_test_patterns = Nothing,
ropt_xml_output = Nothing,
ropt_xml_nested = Nothing,
- ropt_plain_output = Nothing,
+ ropt_color_mode = Nothing,
ropt_hide_successes = Nothing
}
@@ -36,6 +37,6 @@ instance Monoid (RunnerOptions' Maybe) where
ropt_test_patterns = mappendBy ropt_test_patterns ro1 ro2,
ropt_xml_output = mappendBy ropt_xml_output ro1 ro2,
ropt_xml_nested = getLast (mappendBy (Last . ropt_xml_nested) ro1 ro2),
- ropt_plain_output = getLast (mappendBy (Last . ropt_plain_output) ro1 ro2),
+ ropt_color_mode = getLast (mappendBy (Last . ropt_color_mode) ro1 ro2),
ropt_hide_successes = getLast (mappendBy (Last . ropt_hide_successes) ro1 ro2)
}
@@ -1,5 +1,5 @@
Name: test-framework
-Version: 0.4.2.0
+Version: 0.4.2.1
Cabal-Version: >= 1.2.3
Category: Testing
Synopsis: Framework for running and organising tests, with HUnit and QuickCheck support
@@ -47,7 +47,7 @@ data TestCaseResult = TestCasePassed
instance Show TestCaseResult where
show result = case result of
TestCasePassed -> "OK"
- TestCaseFailed message -> "Failed: " ++ message
+ TestCaseFailed message -> message
TestCaseError message -> "ERROR: " ++ message
testCaseSucceeded :: TestCaseResult -> Bool

0 comments on commit 9c3126c

Please sign in to comment.