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 --- tests/nanospec/README | 6 -- tests/nanospec/Test/Hspec.hs | 126 ---------------------------------- tests/unit-tests/Haddock/ParseSpec.hs | 81 ---------------------- tests/unit-tests/Spec.hs | 9 --- 4 files changed, 222 deletions(-) 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 (limited to 'tests') 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