From d63c49537da8c2a3ee20e6153e2471087054730d Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Mon, 15 Oct 2012 14:25:39 +0200 Subject: Move unit tests to /test directory --- haddock.cabal | 4 +- test/Haddock/ParseSpec.hs | 81 ++++++++++++++++++++++ test/Spec.hs | 9 +++ test/nanospec/README | 6 ++ test/nanospec/Test/Hspec.hs | 126 ++++++++++++++++++++++++++++++++++ tests/nanospec/README | 6 -- tests/nanospec/Test/Hspec.hs | 126 ---------------------------------- tests/unit-tests/Haddock/ParseSpec.hs | 81 ---------------------- tests/unit-tests/Spec.hs | 9 --- 9 files changed, 224 insertions(+), 224 deletions(-) create mode 100644 test/Haddock/ParseSpec.hs create mode 100644 test/Spec.hs create mode 100644 test/nanospec/README create mode 100644 test/nanospec/Test/Hspec.hs delete mode 100644 tests/nanospec/README delete mode 100644 tests/nanospec/Test/Hspec.hs delete mode 100644 tests/unit-tests/Haddock/ParseSpec.hs delete mode 100644 tests/unit-tests/Spec.hs diff --git a/haddock.cabal b/haddock.cabal index 36c016e9..8f655d83 100644 --- a/haddock.cabal +++ b/haddock.cabal @@ -181,8 +181,8 @@ test-suite spec default-language: Haskell2010 main-is: Spec.hs hs-source-dirs: - tests/unit-tests - , tests/nanospec + test + , test/nanospec , src build-depends: diff --git a/test/Haddock/ParseSpec.hs b/test/Haddock/ParseSpec.hs new file mode 100644 index 00000000..d692cb0c --- /dev/null +++ b/test/Haddock/ParseSpec.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedStrings, StandaloneDeriving, FlexibleInstances, UndecidableInstances, IncoherentInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Haddock.ParseSpec (main, spec) where + +import Test.Hspec +import RdrName (RdrName) +import DynFlags (DynFlags, defaultDynFlags) +import Haddock.Lex (tokenise) +import qualified Haddock.Parse as Parse +import Haddock.Types +import Outputable (Outputable, showSDoc, ppr) +import Data.Monoid +import Data.String + +dynFlags :: DynFlags +dynFlags = defaultDynFlags (error "dynFlags for Haddock tests: undefined") + +instance Outputable a => Show a where + show = showSDoc dynFlags . ppr + +deriving instance Show a => Show (Doc a) +deriving instance Eq a =>Eq (Doc a) + +instance IsString (Doc RdrName) where + fromString = DocString + +parseParas :: String -> Maybe (Doc RdrName) +parseParas s = Parse.parseParas $ tokenise dynFlags s (0,0) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "parseParas" $ do + it "parses a paragraph" $ do + parseParas "foobar" `shouldBe` Just (DocParagraph "foobar\n") + + context "when parsing an example" $ do + it "requires an example to be separated from a previous paragrap by an empty line" $ do + parseParas "foobar\n\n>>> fib 10\n55" `shouldBe` + Just (DocParagraph "foobar\n" <> DocExamples [Example "fib 10" ["55"]]) + + -- parse error + parseParas "foobar\n>>> fib 10\n55" `shouldBe` Nothing + + it "parses a result line that only contains as an emptly line" $ do + parseParas ">>> putFooBar\nfoo\n\nbar" `shouldBe` + Just (DocExamples [Example "putFooBar" ["foo","","bar"]]) + + context "when parsing a code block" $ do + it "requires a code blocks to be separated from a previous paragrap by an empty line" $ do + parseParas "foobar\n\n> some code" `shouldBe` + Just (DocParagraph "foobar\n" <> DocCodeBlock " some code\n") + + -- parse error + parseParas "foobar\n> some code" `shouldBe` Nothing + + + context "when parsing a URL" $ do + it "parses a URL" $ do + parseParas "" `shouldBe` + Just (DocParagraph $ hyperlink "http://example.com/" Nothing <> "\n") + + it "accepts an optional label" $ do + parseParas "" `shouldBe` + Just (DocParagraph $ hyperlink "http://example.com/" (Just "some link") <> "\n") + + context "when parsing properties" $ do + it "can parse a single property" $ do + parseParas "prop> 23 == 23" `shouldBe` Just (DocProperty "23 == 23") + + it "can parse multiple subsequent properties" $ do + parseParas $ unlines [ + "prop> 23 == 23" + , "prop> 42 == 42" + ] + `shouldBe` Just (DocProperty "23 == 23" <> DocProperty "42 == 42") + where + hyperlink :: String -> Maybe String -> Doc RdrName + hyperlink url = DocHyperlink . Hyperlink url diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 00000000..68521c03 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,9 @@ +module Main where + +import Test.Hspec + +import qualified Haddock.ParseSpec + +main :: IO () +main = hspec $ do + describe "Haddock.Parse" Haddock.ParseSpec.spec diff --git a/test/nanospec/README b/test/nanospec/README new file mode 100644 index 00000000..ffce7c74 --- /dev/null +++ b/test/nanospec/README @@ -0,0 +1,6 @@ +A lightweight implementation of a subset of Hspec's API with minimal +dependencies. + +http://hackage.haskell.org/package/nanospec + +This is a copy of version 0.1.0. diff --git a/test/nanospec/Test/Hspec.hs b/test/nanospec/Test/Hspec.hs new file mode 100644 index 00000000..904ce2e0 --- /dev/null +++ b/test/nanospec/Test/Hspec.hs @@ -0,0 +1,126 @@ +{-# LANGUAGE DeriveDataTypeable, CPP #-} +-- | A lightweight implementation of a subset of Hspec's API. +module Test.Hspec ( +-- * Types + SpecM +, Spec + +-- * Defining a spec +, describe +, context +, it + +-- ** Setting expectations +, Expectation +, expect +, shouldBe +, shouldReturn + +-- * Running a spec +, hspec +) where + +import Control.Applicative +import Control.Monad +import Data.Monoid +import Data.List (intercalate) +import Data.Typeable +import qualified Control.Exception as E +import System.Exit + +-- a writer monad +data SpecM a = SpecM a [SpecTree] + +add :: SpecTree -> SpecM () +add s = SpecM () [s] + +instance Monad SpecM where + return a = SpecM a [] + SpecM a xs >>= f = case f a of + SpecM b ys -> SpecM b (xs ++ ys) + +data SpecTree = SpecGroup String Spec + | SpecExample String (IO Result) + +data Result = Success | Failure String + deriving (Eq, Show) + +type Spec = SpecM () + +describe :: String -> Spec -> Spec +describe label = add . SpecGroup label + +context :: String -> Spec -> Spec +context = describe + +it :: String -> Expectation -> Spec +it label = add . SpecExample label . evaluateExpectation + +-- | Summary of a test run. +data Summary = Summary Int Int + +instance Monoid Summary where + mempty = Summary 0 0 + (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) + +runSpec :: Spec -> IO Summary +runSpec = runForrest [] + where + runForrest :: [String] -> Spec -> IO Summary + runForrest labels (SpecM () xs) = mconcat <$> mapM (runTree labels) xs + + runTree :: [String] -> SpecTree -> IO Summary + runTree labels spec = case spec of + SpecExample label x -> do + putStr $ "/" ++ (intercalate "/" . reverse) (label:labels) ++ "/ " + r <- x + case r of + Success -> do + putStrLn "OK" + return (Summary 1 0) + Failure err -> do + putStrLn "FAILED" + putStrLn err + return (Summary 1 1) + SpecGroup label xs -> do + runForrest (label:labels) xs + +hspec :: Spec -> IO () +hspec spec = do + Summary total failures <- runSpec spec + putStrLn (show total ++ " example(s), " ++ show failures ++ " failure(s)") + when (failures /= 0) exitFailure + +type Expectation = IO () + +infix 1 `shouldBe`, `shouldReturn` + +shouldBe :: (Show a, Eq a) => a -> a -> Expectation +actual `shouldBe` expected = + expect ("expected: " ++ show expected ++ "\n but got: " ++ show actual) (actual == expected) + +shouldReturn :: (Show a, Eq a) => IO a -> a -> Expectation +action `shouldReturn` expected = action >>= (`shouldBe` expected) + +expect :: String -> Bool -> Expectation +expect label f + | f = return () + | otherwise = E.throwIO (ExpectationFailure label) + +data ExpectationFailure = ExpectationFailure String + deriving (Show, Eq, Typeable) + +instance E.Exception ExpectationFailure + +evaluateExpectation :: Expectation -> IO Result +evaluateExpectation action = (action >> return Success) + `E.catches` [ + -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT + -- (ctrl-c). All AsyncExceptions are re-thrown (not just UserInterrupt) + -- because all of them indicate severe conditions and should not occur during + -- normal operation. + E.Handler $ \e -> E.throw (e :: E.AsyncException) + + , E.Handler $ \(ExpectationFailure err) -> return (Failure err) + , E.Handler $ \e -> (return . Failure) ("*** Exception: " ++ show (e :: E.SomeException)) + ] diff --git a/tests/nanospec/README b/tests/nanospec/README deleted file mode 100644 index ffce7c74..00000000 --- a/tests/nanospec/README +++ /dev/null @@ -1,6 +0,0 @@ -A lightweight implementation of a subset of Hspec's API with minimal -dependencies. - -http://hackage.haskell.org/package/nanospec - -This is a copy of version 0.1.0. diff --git a/tests/nanospec/Test/Hspec.hs b/tests/nanospec/Test/Hspec.hs deleted file mode 100644 index 904ce2e0..00000000 --- a/tests/nanospec/Test/Hspec.hs +++ /dev/null @@ -1,126 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, CPP #-} --- | A lightweight implementation of a subset of Hspec's API. -module Test.Hspec ( --- * Types - SpecM -, Spec - --- * Defining a spec -, describe -, context -, it - --- ** Setting expectations -, Expectation -, expect -, shouldBe -, shouldReturn - --- * Running a spec -, hspec -) where - -import Control.Applicative -import Control.Monad -import Data.Monoid -import Data.List (intercalate) -import Data.Typeable -import qualified Control.Exception as E -import System.Exit - --- a writer monad -data SpecM a = SpecM a [SpecTree] - -add :: SpecTree -> SpecM () -add s = SpecM () [s] - -instance Monad SpecM where - return a = SpecM a [] - SpecM a xs >>= f = case f a of - SpecM b ys -> SpecM b (xs ++ ys) - -data SpecTree = SpecGroup String Spec - | SpecExample String (IO Result) - -data Result = Success | Failure String - deriving (Eq, Show) - -type Spec = SpecM () - -describe :: String -> Spec -> Spec -describe label = add . SpecGroup label - -context :: String -> Spec -> Spec -context = describe - -it :: String -> Expectation -> Spec -it label = add . SpecExample label . evaluateExpectation - --- | Summary of a test run. -data Summary = Summary Int Int - -instance Monoid Summary where - mempty = Summary 0 0 - (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) - -runSpec :: Spec -> IO Summary -runSpec = runForrest [] - where - runForrest :: [String] -> Spec -> IO Summary - runForrest labels (SpecM () xs) = mconcat <$> mapM (runTree labels) xs - - runTree :: [String] -> SpecTree -> IO Summary - runTree labels spec = case spec of - SpecExample label x -> do - putStr $ "/" ++ (intercalate "/" . reverse) (label:labels) ++ "/ " - r <- x - case r of - Success -> do - putStrLn "OK" - return (Summary 1 0) - Failure err -> do - putStrLn "FAILED" - putStrLn err - return (Summary 1 1) - SpecGroup label xs -> do - runForrest (label:labels) xs - -hspec :: Spec -> IO () -hspec spec = do - Summary total failures <- runSpec spec - putStrLn (show total ++ " example(s), " ++ show failures ++ " failure(s)") - when (failures /= 0) exitFailure - -type Expectation = IO () - -infix 1 `shouldBe`, `shouldReturn` - -shouldBe :: (Show a, Eq a) => a -> a -> Expectation -actual `shouldBe` expected = - expect ("expected: " ++ show expected ++ "\n but got: " ++ show actual) (actual == expected) - -shouldReturn :: (Show a, Eq a) => IO a -> a -> Expectation -action `shouldReturn` expected = action >>= (`shouldBe` expected) - -expect :: String -> Bool -> Expectation -expect label f - | f = return () - | otherwise = E.throwIO (ExpectationFailure label) - -data ExpectationFailure = ExpectationFailure String - deriving (Show, Eq, Typeable) - -instance E.Exception ExpectationFailure - -evaluateExpectation :: Expectation -> IO Result -evaluateExpectation action = (action >> return Success) - `E.catches` [ - -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT - -- (ctrl-c). All AsyncExceptions are re-thrown (not just UserInterrupt) - -- because all of them indicate severe conditions and should not occur during - -- normal operation. - E.Handler $ \e -> E.throw (e :: E.AsyncException) - - , E.Handler $ \(ExpectationFailure err) -> return (Failure err) - , E.Handler $ \e -> (return . Failure) ("*** Exception: " ++ show (e :: E.SomeException)) - ] diff --git a/tests/unit-tests/Haddock/ParseSpec.hs b/tests/unit-tests/Haddock/ParseSpec.hs deleted file mode 100644 index d692cb0c..00000000 --- a/tests/unit-tests/Haddock/ParseSpec.hs +++ /dev/null @@ -1,81 +0,0 @@ -{-# LANGUAGE OverloadedStrings, StandaloneDeriving, FlexibleInstances, UndecidableInstances, IncoherentInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Haddock.ParseSpec (main, spec) where - -import Test.Hspec -import RdrName (RdrName) -import DynFlags (DynFlags, defaultDynFlags) -import Haddock.Lex (tokenise) -import qualified Haddock.Parse as Parse -import Haddock.Types -import Outputable (Outputable, showSDoc, ppr) -import Data.Monoid -import Data.String - -dynFlags :: DynFlags -dynFlags = defaultDynFlags (error "dynFlags for Haddock tests: undefined") - -instance Outputable a => Show a where - show = showSDoc dynFlags . ppr - -deriving instance Show a => Show (Doc a) -deriving instance Eq a =>Eq (Doc a) - -instance IsString (Doc RdrName) where - fromString = DocString - -parseParas :: String -> Maybe (Doc RdrName) -parseParas s = Parse.parseParas $ tokenise dynFlags s (0,0) - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "parseParas" $ do - it "parses a paragraph" $ do - parseParas "foobar" `shouldBe` Just (DocParagraph "foobar\n") - - context "when parsing an example" $ do - it "requires an example to be separated from a previous paragrap by an empty line" $ do - parseParas "foobar\n\n>>> fib 10\n55" `shouldBe` - Just (DocParagraph "foobar\n" <> DocExamples [Example "fib 10" ["55"]]) - - -- parse error - parseParas "foobar\n>>> fib 10\n55" `shouldBe` Nothing - - it "parses a result line that only contains as an emptly line" $ do - parseParas ">>> putFooBar\nfoo\n\nbar" `shouldBe` - Just (DocExamples [Example "putFooBar" ["foo","","bar"]]) - - context "when parsing a code block" $ do - it "requires a code blocks to be separated from a previous paragrap by an empty line" $ do - parseParas "foobar\n\n> some code" `shouldBe` - Just (DocParagraph "foobar\n" <> DocCodeBlock " some code\n") - - -- parse error - parseParas "foobar\n> some code" `shouldBe` Nothing - - - context "when parsing a URL" $ do - it "parses a URL" $ do - parseParas "" `shouldBe` - Just (DocParagraph $ hyperlink "http://example.com/" Nothing <> "\n") - - it "accepts an optional label" $ do - parseParas "" `shouldBe` - Just (DocParagraph $ hyperlink "http://example.com/" (Just "some link") <> "\n") - - context "when parsing properties" $ do - it "can parse a single property" $ do - parseParas "prop> 23 == 23" `shouldBe` Just (DocProperty "23 == 23") - - it "can parse multiple subsequent properties" $ do - parseParas $ unlines [ - "prop> 23 == 23" - , "prop> 42 == 42" - ] - `shouldBe` Just (DocProperty "23 == 23" <> DocProperty "42 == 42") - where - hyperlink :: String -> Maybe String -> Doc RdrName - hyperlink url = DocHyperlink . Hyperlink url diff --git a/tests/unit-tests/Spec.hs b/tests/unit-tests/Spec.hs deleted file mode 100644 index 68521c03..00000000 --- a/tests/unit-tests/Spec.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Main where - -import Test.Hspec - -import qualified Haddock.ParseSpec - -main :: IO () -main = hspec $ do - describe "Haddock.Parse" Haddock.ParseSpec.spec -- cgit v1.2.3