mirror of
https://github.com/kowainik/relude.git
synced 2024-09-11 04:35:39 +03:00
added tasty + hedgehog property test infrastucture with a few simple tests
This commit is contained in:
parent
b0fc7c1b1b
commit
3a610bbd34
11
shell.nix
Normal file
11
shell.nix
Normal file
@ -0,0 +1,11 @@
|
||||
{ghc}:
|
||||
with (import <nixpkgs> {});
|
||||
|
||||
haskell.lib.buildStackProject {
|
||||
inherit ghc;
|
||||
name = "myEnv";
|
||||
buildInputs = [ zlib binutils gmp];
|
||||
buildPhase = ''
|
||||
export LANG=en_US.UTF-8
|
||||
'';
|
||||
}
|
@ -1,4 +1,10 @@
|
||||
resolver: lts-10.4
|
||||
|
||||
nix:
|
||||
packages: [binutils, gmp]
|
||||
enable: true
|
||||
shell-file: shell.nix
|
||||
|
||||
extra-deps:
|
||||
- tasty-0.12.0.1
|
||||
|
||||
allow-newer: true
|
||||
|
9
test/Spec.hs
Normal file
9
test/Spec.hs
Normal file
@ -0,0 +1,9 @@
|
||||
module Main where
|
||||
|
||||
import Test.Tasty (defaultMain, testGroup)
|
||||
|
||||
import Test.Universum.Property (hedgehogTestTree)
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
defaultMain hedgehogTestTree
|
104
test/Test/Universum/Property.hs
Normal file
104
test/Test/Universum/Property.hs
Normal file
@ -0,0 +1,104 @@
|
||||
|
||||
module Test.Universum.Property
|
||||
( hedgehogTestTree
|
||||
) where
|
||||
|
||||
import Universum
|
||||
import Hedgehog
|
||||
import Test.Tasty
|
||||
import Test.Tasty.Hedgehog
|
||||
|
||||
import qualified Hedgehog.Gen as Gen
|
||||
import qualified Hedgehog.Range as Range
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as LB
|
||||
import qualified Data.ByteString.Lazy.UTF8 as LBU
|
||||
import qualified Data.ByteString.UTF8 as BU
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.Text.Encoding.Error as T
|
||||
import qualified Data.Text.Lazy as LT
|
||||
import qualified Data.Text.Lazy.Encoding as LT
|
||||
|
||||
import Data.List (nub)
|
||||
|
||||
|
||||
hedgehogTestTree :: TestTree
|
||||
hedgehogTestTree = testGroup "Tests" [utfProps, listProps, boolMProps]
|
||||
|
||||
utfProps :: TestTree
|
||||
utfProps = testGroup "utf8 conversion property tests"
|
||||
[ testProperty "String to ByteString invertible" prop_StringToBytes
|
||||
, testProperty "Text to ByteString invertible" prop_TextToBytes
|
||||
, testProperty "ByteString to Text or String invertible" prop_BytesTo
|
||||
]
|
||||
|
||||
utf8String :: Gen String
|
||||
utf8String = Gen.string (Range.linear 0 10000) Gen.unicode
|
||||
|
||||
utf8Text :: Gen T.Text
|
||||
utf8Text = Gen.text (Range.linear 0 10000) Gen.unicode
|
||||
|
||||
utf8Bytes :: Gen B.ByteString
|
||||
utf8Bytes = Gen.utf8 (Range.linear 0 10000) Gen.unicode
|
||||
|
||||
-- "\65534" fails, but this is from BU.toString
|
||||
-- > BU.toString (BU.fromString "\65534") == "\65533"
|
||||
|
||||
prop_StringToBytes :: Property
|
||||
prop_StringToBytes = property $ do
|
||||
str <- forAll utf8String
|
||||
assert $ str == (decodeUtf8 (encodeUtf8 str :: B.ByteString))
|
||||
&& str == (decodeUtf8 (encodeUtf8 str :: LB.ByteString))
|
||||
|
||||
|
||||
prop_TextToBytes :: Property
|
||||
prop_TextToBytes = property $ do
|
||||
txt <- forAll utf8Text
|
||||
assert $ txt == (decodeUtf8 (encodeUtf8 txt :: B.ByteString))
|
||||
&& txt == (decodeUtf8 (encodeUtf8 txt :: LB.ByteString))
|
||||
|
||||
-- "\239\191\190" fails, but this is the same as "\65534" :: String
|
||||
prop_BytesTo :: Property
|
||||
prop_BytesTo = property $ do
|
||||
utf <- forAll utf8Bytes
|
||||
assert $ utf == (encodeUtf8 (decodeUtf8 utf :: String))
|
||||
&& utf == (encodeUtf8 (decodeUtf8 utf :: T.Text))
|
||||
&& utf == (encodeUtf8 (decodeUtf8 utf :: LT.Text))
|
||||
|
||||
-- ordNub
|
||||
|
||||
listProps :: TestTree
|
||||
listProps = testGroup "list function property tests"
|
||||
[ testProperty "Hedgehog ordNub xs == nub xs" prop_ordNubCorrect
|
||||
]
|
||||
|
||||
genIntList :: Gen [Int]
|
||||
genIntList = Gen.list (Range.linear 0 10000) Gen.enumBounded
|
||||
|
||||
prop_ordNubCorrect :: Property
|
||||
prop_ordNubCorrect = property $ do
|
||||
xs <- forAll genIntList
|
||||
ordNub xs === Data.List.nub xs
|
||||
|
||||
-- logicM
|
||||
|
||||
genBoolList :: Gen [Bool]
|
||||
genBoolList = Gen.list (Range.linear 0 1000) Gen.bool
|
||||
|
||||
boolMProps :: TestTree
|
||||
boolMProps = testGroup "lifted logic function property tests"
|
||||
[ testProperty "Hedgehog andM" prop_andM
|
||||
, testProperty "Hedgehog orM" prop_orM
|
||||
]
|
||||
|
||||
prop_andM :: Property
|
||||
prop_andM = property $ do
|
||||
bs <- forAll genBoolList
|
||||
andM (return <$> bs) === ((return $ Universum.and bs) :: Maybe Bool)
|
||||
|
||||
prop_orM :: Property
|
||||
prop_orM = property $ do
|
||||
bs <- forAll genBoolList
|
||||
orM (return <$> bs) === ((return $ Universum.or bs) :: Maybe Bool)
|
@ -91,6 +91,25 @@ library
|
||||
default-extensions: NoImplicitPrelude
|
||||
OverloadedStrings
|
||||
|
||||
test-suite universum-test
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
main-is: Spec.hs
|
||||
|
||||
other-modules: Test.Universum.Property
|
||||
|
||||
build-depends: base >= 4.8 && < 5
|
||||
, universum
|
||||
, bytestring
|
||||
, text
|
||||
, utf8-string
|
||||
, hedgehog ^>= 0.5.1
|
||||
, tasty ^>= 0.12
|
||||
, tasty-hedgehog ^>= 0.1
|
||||
|
||||
ghc-options: -Wall -threaded
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite universum-doctest
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test
|
||||
|
Loading…
Reference in New Issue
Block a user