diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright 2013 Oliver Charles + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Test/Tasty/Runners/AntXML.hs b/Test/Tasty/Runners/AntXML.hs new file mode 100644 --- /dev/null +++ b/Test/Tasty/Runners/AntXML.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +-- | Run a 'Tasty.TestTree' and produce an XML file summarising the test results +-- in the same schema that would be produced by Apache Ant's JUnit test runner. +-- This schema can be intepreted by the Jenkins continuous integration server, +-- amongst other tools. +module Test.Tasty.Runners.AntXML (antXMLRunner) where + +import Control.Applicative +import Control.Arrow (first) +import Control.Monad.Trans.Class (lift) +import Data.Maybe (fromMaybe) +import Data.Monoid (Monoid(..), Endo(..), Sum(..)) +import Data.Proxy (Proxy(..)) +import Data.Semigroup.Applicative (Traversal(..)) +import Data.Tagged (Tagged(..)) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Generics.Deriving.Monoid (memptydefault, mappenddefault) + +import qualified Control.Concurrent.STM as STM +import qualified Control.Monad.State as State +import qualified Data.Functor.Compose as Functor +import qualified Data.IntMap as IntMap +import qualified Test.Tasty.Options as Tasty +import qualified Test.Tasty.Providers as Tasty +import qualified Test.Tasty.Runners as Tasty +import qualified Text.XML.Light as XML + +-------------------------------------------------------------------------------- +newtype AntXMLPath = AntXMLPath FilePath + deriving (Typeable) + +instance Tasty.IsOption (Maybe AntXMLPath) where + defaultValue = Nothing + parseValue = Just . Just . AntXMLPath + optionName = Tagged "xml" + optionHelp = Tagged "A file path to store the test results in Ant-compatible XML" + + +-------------------------------------------------------------------------------- +data Summary = Summary { summaryFailures :: Sum Int + , summaryErrors :: Sum Int + , summarySuccesses :: Sum Int + , xmlRenderer :: Endo XML.Element + } deriving (Generic) + +instance Monoid Summary where + mempty = memptydefault + mappend = mappenddefault + + +-------------------------------------------------------------------------------- +-- To run tests using this ingredient, use 'Tasty.defaultMainWithIngredients', +-- passing 'antXMLRunner' as one possible ingredient. This ingredient will run +-- tests if you pass the @--xml@ command line option. For example, +-- @--xml=junit.xml@ will run all the tests and generate @junit.xml@ as output. +antXMLRunner :: Tasty.Ingredient +antXMLRunner = Tasty.TestReporter optionDescription runner + where + optionDescription = [ Tasty.Option (Proxy :: Proxy (Maybe AntXMLPath)) ] + runner options testTree = do + AntXMLPath path <- Tasty.lookupOption options + + return $ \statusMap -> + let + + runTest _ testName _ = Traversal $ Functor.Compose $ do + i <- State.get + + summary <- lift $ STM.atomically $ do + status <- STM.readTVar $ + fromMaybe (error "Attempted to lookup test by index outside bounds") $ + IntMap.lookup i statusMap + + let testCaseAttributes = map (uncurry XML.Attr . first XML.unqual) + [ ("name", testName ) ] + + mkSummary contents = + mempty { xmlRenderer = Endo + (`appendChild` XML.node (XML.unqual "testcase") contents) + } + + mkSuccess = (mkSummary testCaseAttributes) { summarySuccesses = Sum 1 } + + mkFailure reason = + mkSummary ( testCaseAttributes + , XML.node (XML.unqual "failure") reason + ) + + case status of + -- If the test is done, generate XML for it + Tasty.Done result + | Tasty.resultSuccessful result -> pure mkSuccess + | otherwise -> pure $ + (mkFailure (Tasty.resultDescription result)) + { summaryFailures = Sum 1 } + + Tasty.Exception e -> pure $ + (mkFailure (show e)) { summaryErrors = Sum 1 } + + -- Otherwise the test has either not been started or is currently + -- executing + _ -> STM.retry + + Const summary <$ State.modify (+ 1) + + runGroup groupName children = Traversal $ Functor.Compose $ do + Const soFar <- Functor.getCompose $ getTraversal children + let grouped = appEndo (xmlRenderer soFar) $ + XML.node (XML.unqual "testsuite") $ + XML.Attr (XML.unqual "name") groupName + + pure $ Const + soFar { xmlRenderer = Endo (`appendChild` grouped) + } + + in do + (Const summary, tests) <- + flip State.runStateT 0 $ Functor.getCompose $ getTraversal $ + Tasty.foldTestTree runTest runGroup options testTree + + writeFile path $ + XML.showTopElement $ + appEndo (xmlRenderer summary) $ + XML.node + (XML.unqual "testsuites") + [ XML.Attr (XML.unqual "errors") + (show . getSum . summaryErrors $ summary) + , XML.Attr (XML.unqual "failures") + (show . getSum . summaryFailures $ summary) + , XML.Attr (XML.unqual "tests") (show tests) + ] + + return (getSum ((summaryFailures `mappend` summaryErrors) summary) == 0) + + appendChild parent child = + parent { XML.elContent = XML.elContent parent ++ [ XML.Elem child ] } diff --git a/tasty-ant-xml.cabal b/tasty-ant-xml.cabal new file mode 100644 --- /dev/null +++ b/tasty-ant-xml.cabal @@ -0,0 +1,28 @@ +name: tasty-ant-xml +version: 1.0.0 +synopsis: A tasty ingredient to output test results in XML, using the Ant schema. This XML can be consumed by the Jenkins continuous integration framework. +homepage: http://github.com/ocharles/tasty-ant-xml +license: BSD3 +license-file: LICENSE +author: Oliver Charles +maintainer: ollie@ocharles.org.uk +copyright: Oliver Charles 2013 +category: Testing +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Test.Tasty.Runners.AntXML + build-depends: + base >= 4.5 && < 5, + containers >= 0.5.0.0, + generic-deriving >= 1.6.2, + mtl >= 2.1.2, + reducers >= 3.10.1, + stm >= 2.4.2, + tagged >= 0.7, + tasty >= 0.4.0.1, + transformers >= 0.3.0.0, + xml >= 1.3.13 + default-language: Haskell98 + ghc-options: -Wall -O2