aboutsummaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/nanospec/README6
-rw-r--r--tests/nanospec/Test/Hspec.hs126
-rw-r--r--tests/unit-tests/Haddock/ParseSpec.hs81
-rw-r--r--tests/unit-tests/Spec.hs9
4 files changed, 0 insertions, 222 deletions
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 <BLANKLINE> as an emptly line" $ do
- parseParas ">>> putFooBar\nfoo\n<BLANKLINE>\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 "<http://example.com/>" `shouldBe`
- Just (DocParagraph $ hyperlink "http://example.com/" Nothing <> "\n")
-
- it "accepts an optional label" $ do
- parseParas "<http://example.com/ some link>" `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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-03 19:24:34 +0000