fix[test]: quickcheck-instances panics when creating empty arrays
This commit is contained in:
parent
c78d261a1b
commit
786ded3e43
3 changed files with 26 additions and 4 deletions
|
@ -19,6 +19,7 @@ extra-source-files:
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
|
Data.Array.Arbitrary
|
||||||
Language.Json
|
Language.Json
|
||||||
Language.Json.Parser
|
Language.Json.Parser
|
||||||
Language.Json.Path
|
Language.Json.Path
|
||||||
|
|
22
src/Data/Array/Arbitrary.hs
Normal file
22
src/Data/Array/Arbitrary.hs
Normal file
|
@ -0,0 +1,22 @@
|
||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
module Data.Array.Arbitrary (ArbitraryArray(..), get) where
|
||||||
|
import Test.QuickCheck (Arbitrary (arbitrary), Gen)
|
||||||
|
import Data.Array.IArray (listArray, IArray, Ix)
|
||||||
|
import Data.List (genericLength)
|
||||||
|
|
||||||
|
newtype ArbitraryArray a i e = ArbitraryArray { getArbitraryArray :: a i e }
|
||||||
|
deriving stock (Show)
|
||||||
|
|
||||||
|
get :: ArbitraryArray a i e -> a i e
|
||||||
|
get = getArbitraryArray
|
||||||
|
|
||||||
|
instance (Arbitrary e, Num i, Ix i, IArray a e) => Arbitrary (ArbitraryArray a i e) where
|
||||||
|
arbitrary :: Gen (ArbitraryArray a i e)
|
||||||
|
arbitrary = do
|
||||||
|
xs <- arbitrary
|
||||||
|
pure . ArbitraryArray $ case xs of
|
||||||
|
[] -> listArray (1, 0) xs
|
||||||
|
_ -> listArray (0, genericLength xs - 1) xs
|
||||||
|
|
|
@ -28,8 +28,7 @@ import GHC.Generics ( Generic, Generically(..) )
|
||||||
import Pretty.Serialize (PrettySerialize)
|
import Pretty.Serialize (PrettySerialize)
|
||||||
import Test.QuickCheck (Arbitrary (arbitrary), Gen, UnicodeString (getUnicodeString), PrintableString (getPrintableString))
|
import Test.QuickCheck (Arbitrary (arbitrary), Gen, UnicodeString (getUnicodeString), PrintableString (getPrintableString))
|
||||||
import qualified Test.QuickCheck.Gen as Gen
|
import qualified Test.QuickCheck.Gen as Gen
|
||||||
import Test.QuickCheck.Instances.Array ()
|
import Data.Array.Arbitrary (ArbitraryArray(getArbitraryArray))
|
||||||
import Test.QuickCheck.Instances.Natural ()
|
|
||||||
|
|
||||||
|
|
||||||
data Value
|
data Value
|
||||||
|
@ -50,7 +49,7 @@ instance Arbitrary Value where
|
||||||
, String . Text.pack . getUnicodeString <$> arbitrary
|
, String . Text.pack . getUnicodeString <$> arbitrary
|
||||||
, Boolean <$> arbitrary
|
, Boolean <$> arbitrary
|
||||||
, Number <$> arbitrary
|
, Number <$> arbitrary
|
||||||
, Array <$> Gen.scale (`div` 2) arbitrary
|
, Array . getArbitraryArray <$> Gen.scale (`div` 2) arbitrary
|
||||||
, Object . Map.mapKeys (Text.pack . getUnicodeString) <$> Gen.scale (`div` 2) arbitrary
|
, Object . Map.mapKeys (Text.pack . getUnicodeString) <$> Gen.scale (`div` 2) arbitrary
|
||||||
]
|
]
|
||||||
|
|
||||||
|
@ -64,7 +63,7 @@ instance Arbitrary PrintableValue where
|
||||||
, String . Text.pack . getPrintableString <$> arbitrary
|
, String . Text.pack . getPrintableString <$> arbitrary
|
||||||
, Boolean <$> arbitrary
|
, Boolean <$> arbitrary
|
||||||
, Number <$> arbitrary
|
, Number <$> arbitrary
|
||||||
, Array <$> Gen.scale (`div` 2) arbitrary
|
, Array . getArbitraryArray <$> Gen.scale (`div` 2) arbitrary
|
||||||
, Object . Map.mapKeys (Text.pack . getPrintableString) <$> Gen.scale (`div` 2) arbitrary
|
, Object . Map.mapKeys (Text.pack . getPrintableString) <$> Gen.scale (`div` 2) arbitrary
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue