tasty-tap (empty) → 0.0.1
raw patch · 7 files changed
+232/−0 lines, 7 filesdep +basedep +containersdep +directorysetup-changed
Dependencies added: base, containers, directory, stm, tasty, tasty-golden, tasty-hunit, tasty-tap
Files
- LICENSE +20/−0
- README.md +1/−0
- Setup.hs +2/−0
- changelog.md +2/−0
- src/Test/Tasty/Runners/TAP.hs +84/−0
- tasty-tap.cabal +58/−0
- test/Main.hs +65/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Michael Xavier++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,1 @@+# tasty-tap - TAP (Test Anything Protocol) formatter for tasty
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ changelog.md view
@@ -0,0 +1,2 @@+0.0.1+* Initial release
+ src/Test/Tasty/Runners/TAP.hs view
@@ -0,0 +1,84 @@+-- | This is a TAP13 (Test Anything Protocol version 13) compatible+-- test output formatter for tasty. You can read more about tap+-- <https://testanything.org/ here>.+module Test.Tasty.Runners.TAP+ ( tapRunner+ , tapRunner'+ ) where+++-------------------------------------------------------------------------------+import Control.Concurrent.STM+import Control.Monad+import qualified Data.IntMap.Strict as IM+import Data.List+import Data.Maybe+import Data.Monoid+import System.IO+import Test.Tasty.Ingredients+import Test.Tasty.Options+import Test.Tasty.Runners+-------------------------------------------------------------------------------+++tapRunner :: Ingredient+tapRunner = tapRunner' stdout++-------------------------------------------------------------------------------+tapRunner' :: Handle -> Ingredient+tapRunner' h = TestReporter reporterOpts go+ where reporterOpts = []+ go opts tree = (Just (tapCallback h opts tree))+++-------------------------------------------------------------------------------+tapCallback+ :: Handle+ -> OptionSet+ -> TestTree+ -> StatusMap+ -> IO (Time -> IO Bool)+tapCallback h opts tree smap = do+ let names = IM.fromList (zip [0..] (testsNames opts tree))+ hPutStrLn h tapHeader+ hPutStrLn h (tapPlan smap)+ results <- forM (IM.toList smap) $ \(idx, stat) -> do+ let n = fromMaybe mempty (IM.lookup idx names)+ reportStatus h n idx stat+ return (const (return (and results)))+++-------------------------------------------------------------------------------+tapHeader :: String+tapHeader = "TAP version 13"+++-------------------------------------------------------------------------------+tapPlan :: StatusMap -> String+tapPlan sm | IM.null sm = "Bail out! There were no tests to run."+ | otherwise = "1.." <> show (IM.size sm)+++-------------------------------------------------------------------------------+reportStatus :: Handle -> String -> Int -> TVar Status -> IO Bool+reportStatus h name zeroIdx statRef = do+ res <- atomically (waitFinished )+ hPutStrLn h (renderResult res)+ return (resultSuccessful res)+ where testNum = zeroIdx + 1+ waitFinished = do stat <- readTVar statRef+ case stat of+ Done res -> return res+ _ -> retry+ renderResult res+ | resultSuccessful res = "ok " <> show testNum <> " - " <> name <> desc+ | otherwise = "not ok " <> show testNum <> " - " <> name <> desc+ --TODO: how do we get the test name?+ where desc = case resultDescription res of+ "" -> ""+ nonEmpty -> "\n" <> formatDesc nonEmpty+++-------------------------------------------------------------------------------+formatDesc :: String -> String+formatDesc = intercalate "\n" . map ("# " <> ) . lines
+ tasty-tap.cabal view
@@ -0,0 +1,58 @@+name: tasty-tap+version: 0.0.1+synopsis: TAP (Test Anything Protocol) Version 13 formatter for tasty+description: A tasty ingredient to output test results in TAP 13 format.+license: MIT+license-file: LICENSE+author: Michael Xavier+maintainer: michael@michaelxavier.net+homepage: https://github.com/michaelxavier/tasty-tap+copyright: (C) 2015 Michael Xavier+category: Testing+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1+extra-source-files:+ README.md+ changelog.md++source-repository head+ type: git+ location: git://github.com/michaelxavier/tasty-tap.git++flag lib-Werror+ default: False+ manual: True++library+ exposed-modules: Test.Tasty.Runners.TAP+ build-depends: base >=4.6 && <4.9+ , tasty >= 0.10 && < 0.11+ , stm+ , containers+ hs-source-dirs: src+ default-language: Haskell2010++ if flag(lib-Werror)+ ghc-options: -Werror++ ghc-options: -Wall+++test-suite test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ default-language: Haskell2010++ build-depends: base+ , tasty+ , tasty-tap+ , tasty-hunit+ , tasty-golden+ , directory++ if flag(lib-Werror)+ ghc-options: -Werror++ ghc-options: -Wall
+ test/Main.hs view
@@ -0,0 +1,65 @@+module Main+ ( main+ ) where+++-------------------------------------------------------------------------------+import Control.Exception+import System.Directory+import System.Exit+import System.IO+import Test.Tasty+import Test.Tasty.Golden+import Test.Tasty.HUnit+-------------------------------------------------------------------------------+import Test.Tasty.Runners.TAP+-------------------------------------------------------------------------------++++--TODO: actually make assertions+main :: IO ()+main = do+ tmpDir <- getTemporaryDirectory+ defaultMain (tests tmpDir)+ -- defaultMainWithIngredients [tapRunner] exampleTests+++-------------------------------------------------------------------------------+tests :: FilePath -> TestTree+tests tmpDir = testGroup "Test.Tasty.Runners.TAP"+ [+ let tmpPath = tmpDir ++ "/simple.tap"+ in goldenVsFileDiff "simple.tap"+ diffCmd+ (goldenPath "simple.tap")+ tmpPath+ (mkSimple tmpPath)+ ]+++-------------------------------------------------------------------------------+diffCmd :: FilePath -> FilePath -> [String]+diffCmd ref new = ["diff", "-u", ref, new]+++-------------------------------------------------------------------------------+mkSimple :: FilePath -> IO ()+mkSimple tmpPath = bracket (openFile tmpPath WriteMode) hClose $ \h -> do+ defaultMainWithIngredients [tapRunner' h] exampleTests `catch` interceptExit+ where interceptExit :: ExitCode -> IO ()+ interceptExit _ = return ()+++-------------------------------------------------------------------------------+exampleTests :: TestTree+exampleTests = testGroup "some example tests"+ [+ testCase "passes" $ assertBool "uh your computer is busted" True+ , testCase "fails" $ assertFailure "this was doomed"+ ]+++-------------------------------------------------------------------------------+goldenPath :: FilePath -> FilePath+goldenPath fp = "test/golden/" ++ fp