packages feed

hunit-gui 0.1.1 → 0.1.2

raw patch · 5 files changed

+98/−4 lines, 5 filesdep +haskell98

Dependencies added: haskell98

Files

Test/HUnit/Gui/Descriptions.hs view
@@ -1,8 +1,9 @@-module Test.HUnit.Gui.Descriptions (describeError, describeFailure)+module Test.HUnit.Gui.Descriptions (describeError, describeFailure, describePath) where +import List+import Maybe import Test.HUnit.Base-import Test.HUnit.Text (showPath)  describeError :: String -> State -> String describeError = describeProblem@@ -15,5 +16,23 @@     let path' = path state     in if null path'        then msg-       else (showPath path') ++ ":\n" ++ msg+       else (describePath path') ++ ":\n" ++ msg++describePath :: Path -> String+describePath [] = "?"+describePath p = case labels of [] -> prettyPrint listItems+                                _ -> concat [prettyPrint labels, " (", prettyPrint listItems, ")"]+    where+          prettyPrint = concat . intersperse ":" . reverse+          deListItem (ListItem i) = Just $ show i+          deListItem _ = Nothing+          deLabel (Label str) = Just str+          deLabel _ = Nothing+          escapeChar '\'' = ("\\'" ++)+          escapeChar c = (c:)+          prettyPrintLabel l = if ':' `elem` l+                               then "'" ++ (foldr escapeChar "" l) ++ "'"+                               else l+          labels = map prettyPrintLabel $ catMaybes $ map deLabel p+          listItems = catMaybes $ map deListItem p 
hunit-gui.cabal view
@@ -1,5 +1,5 @@ Name:           hunit-gui-Version:        0.1.1+Version:        0.1.2 Cabal-Version:  >= 1.6 License:        PublicDomain Author:         Kim Wallmark@@ -26,6 +26,7 @@   Hs-Source-Dirs:   .   Build-Depends:     base == 3.*,+    haskell98,     HUnit == 1.2.*,     gtk == 0.10.*,     cairo == 0.10.*@@ -33,9 +34,14 @@  Executable tests   Main-Is:           AllTests.hs+  Other-Modules:+    BarComputationsTests+    DescriptionsTests+    StatusTests   Hs-Source-Dirs:    . tests   Build-Depends:     base == 3.*,+    haskell98,     HUnit == 1.2.*,     gtk == 0.10.*,     cairo == 0.10.*
+ tests/BarComputationsTests.hs view
@@ -0,0 +1,16 @@+module BarComputationsTests (tests)+where++import Control.Monad+import Test.HUnit.Base++import Test.HUnit.Gui.BarComputations++tests :: Test+tests = test [ "normal case" ~: 66.66667 `assertApproxEqual` (barWidth (Counts 3 2 0 0) 100)+             ]++assertApproxEqual :: Double -> Double -> Assertion+assertApproxEqual expected actual =+    unless (abs(expected - actual) < 0.001) (assertFailure msg)+    where msg = "expected: " ++ show expected ++ "\nbut got: " ++ show actual
+ tests/DescriptionsTests.hs view
@@ -0,0 +1,39 @@+module DescriptionsTests (tests)+where++import Test.HUnit.Base++import Test.HUnit.Gui.Descriptions++tests :: Test+tests = test $ describeErrorTests ++ describeFailureTests ++ describePathTests++describeErrorTests :: [Test]+describeErrorTests = +    [ "describeError when you don't know the path" ~:+      "blah blah blah" ~=? describeError "blah blah blah" (State [] undefined)+    , "describeError when you do know the path" ~:+      "the label (2:11):\nblah blah blah" ~=? describeError "blah blah blah" (State [Label "the label", ListItem 11, ListItem 2] undefined)+    ]++describeFailureTests :: [Test]+describeFailureTests =+    [ "describeFailure when you don't know the path" ~:+      "blah blah blah" ~=? describeFailure "blah blah blah" (State [] undefined)+    , "describeFailure when you do know the path" ~:+      "the label (2:11):\nblah blah blah" ~=? describeFailure "blah blah blah" (State [Label "the label", ListItem 11, ListItem 2] undefined)+    ]++describePathTests :: [Test]+describePathTests =+    [ "describe labelless path" ~: "3:5:1" ~=? (describePath $ map ListItem [1,5,3])+    , "describe empty path" ~: "?" ~=? (describePath [])+    , "if there's a label in the path, it gets priority" ~:+      "apples and pears (3:5:1)" ~=? describePath [ListItem 1, Label "apples and pears", ListItem 5, ListItem 3]+    , "multiple labels are joined together" ~:+      "apples:pears:bananas (3:5:1)" ~=? describePath [ListItem 1, Label "bananas", ListItem 5, ListItem 3, Label "pears", Label "apples"]+    , "labels with ':'s in them are quoted" ~:+      "'ratio should be 1:3':apples (5)" ~=? describePath [ListItem 5, Label "apples", Label "ratio should be 1:3"]+    , "quoted labels have their apostrophes escaped" ~:+      "'grocery\\'s ratio should be 1:3' (5)" ~=? describePath [ListItem 5, Label "grocery's ratio should be 1:3"]+    ]
+ tests/StatusTests.hs view
@@ -0,0 +1,14 @@+module StatusTests (tests)+where++import Test.HUnit++import Test.HUnit.Gui.Status++tests :: Test+tests = test [ "errors make the suite fail" ~: Red ~=? (succeeded $ successfulCounts { errors = 1 })+             , "failures make the suite fail" ~: Red ~=? (succeeded $ successfulCounts { failures = 1 })+             , "no bad tests means the suite passes" ~: Green ~=? (succeeded successfulCounts)+             ]+    where+      successfulCounts = Counts 10 10 0 0