conformance-gen (empty) → 0.0.0.0

raw patch · 4 files changed

+167/−0 lines, 4 filesdep +basedep +conformancedep +genvalidity-sydtest

Dependencies added: base, conformance, genvalidity-sydtest, sydtest

Files

• conformance-gen.cabal +43/−0
• src/Conformance/TestUtils.hs +57/−0
• test/ConformanceSpec.hs +66/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,43 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.35.2.+--+-- see: https://github.com/sol/hpack++name:           conformance-gen+version:        0.0.0.0+description:    Testutils for conformance+maintainer:     Tom Sydney Kerckhove <syd@cs-syd.eu>+license:        MIT+build-type:     Simple++library+  exposed-modules:+      Conformance.TestUtils+  other-modules:+      Paths_conformance_gen+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , conformance+    , sydtest+  default-language: Haskell2010++test-suite conformance-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      ConformanceSpec+      Paths_conformance_gen+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      base >=4.7 && <5+    , conformance+    , genvalidity-sydtest+    , sydtest+  default-language: Haskell2010

@@ -0,0 +1,57 @@+module Conformance.TestUtils where++import Conformance+import Control.Monad.IO.Class+import Test.Syd++shouldConformStrict :: (Show ue, Show fe, Show w) => Conform ue fe w a -> IO a+shouldConformStrict = assertStrictResultSucceeded . runConformStrict++shouldConformTStrict :: (Show ue, Show fe, Show w, MonadIO m) => ConformT ue fe w m a -> m a+shouldConformTStrict func = do+  errOrErrOrResult <- runConformTStrict func+  liftIO $ assertStrictResultSucceeded errOrErrOrResult++assertStrictResultSucceeded :: (Show ue, Show fe, Show w) => Either (Either ue (Notes fe w)) a -> IO a+assertStrictResultSucceeded errOrErrOrResult =+  case errOrErrOrResult of+    Left e -> expectationFailure $ show e+    Right a -> pure a++shouldConform :: (Show ue, Show fe) => Conform ue fe w a -> IO a+shouldConform func =+  case runConform func of+    Left hr ->+      expectationFailure $+        unwords+          [ "runConform failed",+            ppShow hr+          ]+    Right (a, _) -> pure a++shouldConformT :: (Show ue, Show fe, MonadIO m) => ConformT ue fe w m a -> m a+shouldConformT func = do+  errOrErrOrResult <- runConformT func+  case errOrErrOrResult of+    Left hr ->+      liftIO $+        expectationFailure $+          unwords+            [ "runConformT failed",+              ppShow hr+            ]+    Right (a, _) -> pure a++shouldConformLenient :: Show ue => Conform ue fe w a -> IO a+shouldConformLenient = assertLenientResultSucceeded . runConformLenient++shouldConformTLenient :: (Show ue, MonadIO m) => ConformT ue fe w m a -> m a+shouldConformTLenient func = do+  errOrErrOrResult <- runConformTLenient func+  liftIO $ assertLenientResultSucceeded errOrErrOrResult++assertLenientResultSucceeded :: Show ue => Either ue (a, Notes fe w) -> IO a+assertLenientResultSucceeded errOrErrOrResult =+  case errOrErrOrResult of+    Left e -> expectationFailure $ show e+    Right (a, _) -> pure a

@@ -0,0 +1,66 @@+module ConformanceSpec (spec) where++import Conformance+import Test.Syd++spec :: Spec+spec = do+  let forceType :: Conform Int Int Int a -> Conform Int Int Int a+      forceType = id+  let forceType' :: Conform Int Int Int Int -> Conform Int Int Int Int+      forceType' = forceType++  describe "runConformStrict" $ do+    it "can succeed" $+      runConformStrict (forceType' (pure 0)) `shouldBe` Right 0++    it "errors on a warning" $+      runConformStrict (forceType (emitWarning 0)) `shouldBe` Left (Right (Notes [] [0]))++    it "errors on a fixable error" $+      runConformStrict (forceType (emitFixableError 0)) `shouldBe` Left (Right (Notes [0] []))++    it "errors on an unfixable error" $+      runConformStrict (forceType' (unfixableError 0)) `shouldBe` Left (Left 0)++  describe "runConform" $ do+    it "can succeed" $+      runConform (forceType' (pure 0)) `shouldBe` Right (0, [])++    it "does not error on a warning" $+      runConform (forceType (emitWarning 0)) `shouldBe` Right ((), [0])++    it "errors on a fixable error" $+      runConform (forceType (emitFixableError 0)) `shouldBe` Left (HaltedBecauseOfStrictness 0)++    it "errors on an unfixable error" $+      runConform (forceType' (unfixableError 0)) `shouldBe` Left (HaltedBecauseOfUnfixableError 0)++  describe "runConformFlexible" $ do+    it "can succeed" $+      runConformFlexible even (forceType' (pure 0)) `shouldBe` Right (0, mempty)++    it "does not error on a warning" $+      runConformFlexible even (forceType (emitWarning 0)) `shouldBe` Right ((), Notes [] [0])++    it "does not error on a fixable error if the predicate holds" $+      runConformFlexible even (forceType (emitFixableError 0)) `shouldBe` Right ((), Notes [0] [])++    it "errors on a fixable error if the predicate does not hold" $+      runConformFlexible even (forceType (emitFixableError 1)) `shouldBe` Left (HaltedBecauseOfStrictness 1)++    it "errors on an unfixable error" $+      runConformFlexible even (forceType' (unfixableError 0)) `shouldBe` Left (HaltedBecauseOfUnfixableError 0)++  describe "runConformLenient" $ do+    it "can succeed" $+      runConformLenient (forceType' (pure 0)) `shouldBe` Right (0, mempty)++    it "does not error on a warning" $+      runConformLenient (forceType (emitWarning 0)) `shouldBe` Right ((), Notes [] [0])++    it "errors on a fixable error" $+      runConformLenient (forceType (emitFixableError 0)) `shouldBe` Right ((), Notes [0] [])++    it "errors on an unfixable error" $+      runConformLenient (forceType' (unfixableError 0)) `shouldBe` Left 0

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}