From 490d69986920a13f677973bb1c8e2ca5f990a895 Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Tue, 21 Nov 2023 14:10:12 +0700 Subject: [PATCH] Add unit tests --- .gitattributes | 1 + cabal.project | 7 +++ hspec-hedgehog.cabal | 34 +++++++++---- package.yaml | 39 ++++++++++++++ test/ExampleSpec.hs | 59 +++++++++++++++++++++ test/Spec.hs | 59 +-------------------- test/Test/Hspec/HedgehogSpec.hs | 90 +++++++++++++++++++++++++++++++++ 7 files changed, 220 insertions(+), 69 deletions(-) create mode 100644 .gitattributes create mode 100644 cabal.project create mode 100644 package.yaml create mode 100644 test/ExampleSpec.hs create mode 100644 test/Test/Hspec/HedgehogSpec.hs diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..4d08d7f --- /dev/null +++ b/.gitattributes @@ -0,0 +1 @@ +*.cabal linguist-generated=true diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..8bc4789 --- /dev/null +++ b/cabal.project @@ -0,0 +1,7 @@ +packages: + hspec-hedgehog.cabal + +package hspec-hedgehog + ghc-options: -Werror + +tests: True diff --git a/hspec-hedgehog.cabal b/hspec-hedgehog.cabal index 8e64d10..c919ed6 100644 --- a/hspec-hedgehog.cabal +++ b/hspec-hedgehog.cabal @@ -1,4 +1,9 @@ cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.36.0. +-- +-- see: https://github.com/sol/hpack + name: hspec-hedgehog version: 0.1.1.0 description: Please see the README on GitHub at @@ -26,24 +31,31 @@ library hs-source-dirs: src build-depends: - base >= 4.7 && < 5 - , hspec >= 2.11.0 && < 3 - , hspec-core >= 2.11.0 && < 3 - , hedgehog >= 1.0.2 && < 2 - , QuickCheck >= 2.9.2 && < 3 - , splitmix >= 0.0.1 && < 1 + QuickCheck >=2.9.2 && <3 + , base >=4.7 && <5 + , hedgehog >=1.0.2 && <2 + , hspec >=2.11.0 && <3 + , hspec-core >=2.11.0 && <3 + , splitmix >=0.0.1 && <1 default-language: Haskell2010 test-suite hspec-hedgehog-test type: exitcode-stdio-1.0 - main-is: - Spec.hs + main-is: Spec.hs + other-modules: + ExampleSpec + Test.Hspec.HedgehogSpec hs-source-dirs: test ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-tool-depends: + hspec-discover:hspec-discover build-depends: - base >= 4.7 && < 5 + HUnit + , QuickCheck + , base >=4.7 && <5 + , hedgehog >=1.0.2 && <2 + , hspec >=2.11.0 && <3 + , hspec-core >=2.11.0 && <3 , hspec-hedgehog - , hspec - , hedgehog >= 1.0.2 && < 2 default-language: Haskell2010 diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..36a6cc5 --- /dev/null +++ b/package.yaml @@ -0,0 +1,39 @@ +spec-version: 0.36.0 + +name: hspec-hedgehog +version: 0.1.1.0 +synopsis: Integrate Hedgehog and Hspec! +description: Please see the README on GitHub at +category: Testing +author: Matt Parsons +maintainer: parsonsmatt@gmail.com +copyright: 2020 Matt Parsons + +extra-source-files: + - README.md + - ChangeLog.md + +github: parsonsmatt/hspec-hedgehog + +dependencies: + - base >= 4.7 && < 5 + - hspec >= 2.11.0 && < 3 + - hspec-core >= 2.11.0 && < 3 + - hedgehog >= 1.0.2 && < 2 + +library: + source-dirs: src + dependencies: + - QuickCheck >= 2.9.2 && < 3 + - splitmix >= 0.0.1 && < 1 + +tests: + hspec-hedgehog-test: + main: Spec.hs + source-dirs: test + build-tools: hspec-discover + dependencies: + - HUnit + - QuickCheck + - hspec-hedgehog + ghc-options: -threaded -rtsopts -with-rtsopts=-N diff --git a/test/ExampleSpec.hs b/test/ExampleSpec.hs new file mode 100644 index 0000000..f5f1d2f --- /dev/null +++ b/test/ExampleSpec.hs @@ -0,0 +1,59 @@ +module ExampleSpec (spec) where +import Test.Hspec +import Control.Concurrent (threadDelay) +import Control.Monad.IO.Class (liftIO) +import Data.IORef (atomicModifyIORef', readIORef, newIORef) +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Hspec.Hedgehog (PropertyT, diff, forAll, hedgehog, + (/==), (===)) +import Test.Hspec.QuickCheck (modifyMaxSuccess) + +spec :: Spec +spec = do + describe "regular tests" $ do + it "works" $ do + True `shouldBe` True + + describe "hedgehog" $ do + it "is useful if you get an ambiguous error" $ hedgehog $ do + "no ambiguity" === "no ambiguity" + + describe "hedgehog tests" $ do + it "lets you use PropertyT directly" $ hedgehog $ do + x <- forAll $ Gen.integral (Range.linear 0 1000) + y <- forAll $ Gen.integral (Range.linear 0 5000) + diff (x + y) (>=) (x :: Integer) + + it "lets you use PropertyT directly without forcing the type" $ do + x <- forAll $ Gen.integral (Range.linear 0 1000) + y <- forAll $ Gen.integral (Range.linear 0 5000) + diff (x + y) (>=) (x :: Integer) + + it "renders a progress bit" $ hedgehog $ do + x <- forAll $ Gen.integral (Range.linear 0 1000) + y <- forAll $ Gen.integral (Range.linear 1 5000) + liftIO $ threadDelay (100 * x + y) + + describe "with hooks" $ do + before (pure "Hello!") $ do + it "has functions" $ \str -> hedgehog $ + str === "Hello!" + + it "goes before or after" $ \str -> do + pure () :: PropertyT IO () + str === "Hello!" + + it "generates" $ \str -> hedgehog $ do + wrongLen <- forAll $ Gen.integral (Range.linear 0 3) + length str /== wrongLen + + describe "modifyMaxSuccess" $ do + modifyMaxSuccess (\_ -> 10) $ do + beforeAll (newIORef (0 :: Integer)) $ do + it "counts to 10" $ \ref -> hedgehog $ do + liftIO $ atomicModifyIORef' ref (\a -> (a + 1, ())) + True === True + it "works" $ \ref -> do + val <- readIORef ref + val `shouldBe` 10 diff --git a/test/Spec.hs b/test/Spec.hs index a51327a..a824f8c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,58 +1 @@ -import Control.Concurrent (threadDelay) -import Control.Monad.IO.Class (liftIO) -import Data.IORef (atomicModifyIORef', readIORef, newIORef) -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range -import Test.Hspec (before, beforeAll, describe, hspec, it, shouldBe) -import Test.Hspec.Hedgehog (PropertyT, diff, forAll, hedgehog, - (/==), (===)) -import Test.Hspec.QuickCheck (modifyMaxSuccess) - -main :: IO () -main = hspec $ do - describe "regular tests" $ do - it "works" $ do - True `shouldBe` True - - describe "hedgehog" $ do - it "is useful if you get an ambiguous error" $ hedgehog $ do - "no ambiguity" === "no ambiguity" - - describe "hedgehog tests" $ do - it "lets you use PropertyT directly" $ hedgehog $ do - x <- forAll $ Gen.integral (Range.linear 0 1000) - y <- forAll $ Gen.integral (Range.linear 0 5000) - diff (x + y) (>=) (x :: Integer) - - it "lets you use PropertyT directly without forcing the type" $ do - x <- forAll $ Gen.integral (Range.linear 0 1000) - y <- forAll $ Gen.integral (Range.linear 0 5000) - diff (x + y) (>=) (x :: Integer) - - it "renders a progress bit" $ hedgehog $ do - x <- forAll $ Gen.integral (Range.linear 0 1000) - y <- forAll $ Gen.integral (Range.linear 1 5000) - liftIO $ threadDelay (100 * x + y) - - describe "with hooks" $ do - before (pure "Hello!") $ do - it "has functions" $ \str -> hedgehog $ - str === "Hello!" - - it "goes before or after" $ \str -> do - pure () :: PropertyT IO () - str === "Hello!" - - it "generates" $ \str -> hedgehog $ do - wrongLen <- forAll $ Gen.integral (Range.linear 0 3) - length str /== wrongLen - - describe "modifyMaxSuccess" $ do - modifyMaxSuccess (\_ -> 10) $ do - beforeAll (newIORef (0 :: Integer)) $ do - it "counts to 10" $ \ref -> hedgehog $ do - liftIO $ atomicModifyIORef' ref (\a -> (a + 1, ())) - True === True - it "works" $ \ref -> do - val <- readIORef ref - val `shouldBe` 10 +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/Test/Hspec/HedgehogSpec.hs b/test/Test/Hspec/HedgehogSpec.hs new file mode 100644 index 0000000..4d91513 --- /dev/null +++ b/test/Test/Hspec/HedgehogSpec.hs @@ -0,0 +1,90 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE StandaloneDeriving #-} +module Test.Hspec.HedgehogSpec (spec) where + +import Test.Hspec +import Test.Hspec.Core.Spec +import Test.Hspec.Core.Util (formatException, stripAnsi) + +import Data.List +import Control.Exception + +import qualified Test.HUnit.Lang as HUnit +import Test.QuickCheck (stdArgs, replay) +import Test.QuickCheck.Random (mkQCGen) + +import Test.Hspec.Hedgehog hiding (eval) + +deriving instance Eq Result +deriving instance Eq ResultStatus +deriving instance Eq FailureReason + +instance Eq SomeException where + (==) = exceptionEq + +exceptionEq :: SomeException -> SomeException -> Bool +exceptionEq a b + | Just ea <- fromException a, Just eb <- fromException b = ea == (eb :: ErrorCall) + | Just ea <- fromException a, Just eb <- fromException b = ea == (eb :: ArithException) + | otherwise = throw (HUnit.HUnitFailure Nothing $ HUnit.ExpectedButGot Nothing (formatException b) (formatException a)) + +progressCallback :: ProgressCallback +progressCallback _ = return () + +params :: Params +params = defaultParams {paramsQuickCheckArgs = stdArgs {replay = Just (mkQCGen 23, 0)}} + +joinLines :: [String] -> String +joinLines = intercalate "\n" + +failingProperty :: PropertyT IO () +failingProperty = failure + +failingPropertyLine :: Int +failingPropertyLine = __LINE__ - 3 + +spec :: Spec +spec = do + describe "evaluateExample" $ do + let + eval :: PropertyT IO () -> IO Result + eval p = evaluateExample p params ($ ()) progressCallback + + context "on Success" $ do + it "includes the number of passed tests" $ do + eval success `shouldReturn` Result + " ✓ property passed 100 tests." + Success + + it "includes classification" $ do + eval (label "foo" >> success) `shouldReturn` Result (joinLines [ + " ✓ property passed 100 tests." + , " foo 100% ████████████████████" + ]) Success + + context "on Failure" $ do + it "includes the number of discarded tests" $ do + eval discard `shouldReturn` Result "" (Failure Nothing (Reason + " ⚐ property gave up after 10 discards, passed 0 tests." + )) + + it "provides a detailed failure message" $ do + Result "" (Failure (Just _loc) (ColorizedReason reason)) <- eval failingProperty + let line delta = " " <> show (failingPropertyLine + delta) + stripAnsi reason `shouldBe` joinLines [ + " ✗ property failed at test/Test/Hspec/HedgehogSpec.hs:" <> show failingPropertyLine <> ":19" + , " after 1 test." + , " shrink path: 1:" + , " " + , " ┏━━ test/Test/Hspec/HedgehogSpec.hs ━━━" + , line -1 <> " ┃ failingProperty :: PropertyT IO ()" + , line 0 <> " ┃ failingProperty = failure" + , " ┃ ^^^^^^^^^^^^^^^^^^^^^^^^^" + , " " + , " This failure can be reproduced by running:" + , " > recheckAt (Seed 14375056955115587481 16778118630780010967) \"1:\" property" + , " " + ]