diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/Gen.hs | 24 | ||||
| -rw-r--r-- | test/Tests/C.hs | 15 | ||||
| -rw-r--r-- | test/Tests/Permutation.hs | 2 | ||||
| -rw-r--r-- | test/Util.hs | 2 |
4 files changed, 28 insertions, 15 deletions
diff --git a/test/Gen.hs b/test/Gen.hs index bf002ca..044de14 100644 --- a/test/Gen.hs +++ b/test/Gen.hs @@ -20,11 +20,10 @@ import Foreign import GHC.TypeLits import GHC.TypeNats qualified as TN -import Data.Array.Mixed.Permutation -import Data.Array.Mixed.Shape -import Data.Array.Mixed.Types import Data.Array.Nested -import Data.Array.Nested.Internal.Shape +import Data.Array.Nested.Permutation +import Data.Array.Nested.Ranked.Shape +import Data.Array.Nested.Types import Hedgehog import Hedgehog.Gen qualified as Gen @@ -60,9 +59,12 @@ shuffleShR = \sh -> go (length sh) (toList sh) sh (dim :$:) <$> go (nbag - 1) bag' sh genShR :: SNat n -> Gen (IShR n) -genShR sn = do +genShR = genShRwithTarget 100_000 + +genShRwithTarget :: Int -> SNat n -> Gen (IShR n) +genShRwithTarget targetMax sn = do let n = fromSNat' sn - targetSize <- Gen.int (Range.linear 0 100_000) + targetSize <- Gen.int (Range.linear 0 targetMax) let genDims :: SNat m -> Int -> Gen (IShR m) genDims SZ _ = return ZSR genDims (SS m) 0 = do @@ -94,10 +96,14 @@ genShR sn = do -- other dimensions might be zero. genReplicatedShR :: m <= n => SNat m -> SNat n -> Gen (IShR m, IShR n, IShR n) genReplicatedShR = \m n -> do - sh1 <- genShR m + let expectedSizeIncrease = round (repvalavg ^ (fromSNat' n - fromSNat' m)) + sh1 <- genShRwithTarget (1_000_000 `div` expectedSizeIncrease) m (sh2, sh3) <- injectOnes n sh1 sh1 return (sh1, sh2, sh3) where + repvalrange = (1::Int, 5) + repvalavg = let (lo, hi) = repvalrange in fromIntegral (lo + hi) / 2 :: Double + injectOnes :: m <= n => SNat n -> IShR m -> IShR m -> Gen (IShR n, IShR n) injectOnes n@SNat shOnes sh | m@SNat <- shrRank sh @@ -106,7 +112,7 @@ genReplicatedShR = \m n -> do EQI -> return (shOnes, sh) GTI -> do index <- Gen.int (Range.linear 0 (fromSNat' m)) - value <- Gen.int (Range.linear 1 5) + value <- Gen.int (uncurry Range.linear repvalrange) Refl <- return (lem n m) injectOnes n (inject index 1 shOnes) (inject index value sh) @@ -116,7 +122,7 @@ genReplicatedShR = \m n -> do inject :: Int -> Int -> IShR m -> IShR (m + 1) inject 0 v sh = v :$: sh inject i v (w :$: sh) = w :$: inject (i - 1) v sh - inject _ v ZSR = v :$: ZSR -- invalid input, but meh + inject _ _ ZSR = error "unreachable" genStorables :: forall a. Storable a => Range Int -> (Word64 -> a) -> GenT IO (VS.Vector a) genStorables rng f = do diff --git a/test/Tests/C.hs b/test/Tests/C.hs index 4861eb1..9567393 100644 --- a/test/Tests/C.hs +++ b/test/Tests/C.hs @@ -18,13 +18,13 @@ import Data.Type.Equality import Foreign import GHC.TypeLits -import Data.Array.Mixed.Types (fromSNat') import Data.Array.Nested -import Data.Array.Nested.Internal.Shape +import Data.Array.Nested.Ranked.Shape +import Data.Array.Nested.Types (fromSNat') import Hedgehog import Hedgehog.Gen qualified as Gen -import Hedgehog.Internal.Property (forAllT) +import Hedgehog.Internal.Property (LabelName(..), forAllT) import Hedgehog.Range qualified as Range import Test.Tasty import Test.Tasty.Hedgehog @@ -39,6 +39,9 @@ import Util fineTol :: Double fineTol = 1e-8 +debugCoverage :: Bool +debugCoverage = False + prop_sum_nonempty :: Property prop_sum_nonempty = property $ genRank $ \outrank@(SNat @n) -> do -- Test nonempty _results_. The first dimension of the input is allowed to be 0, because then OR.rerank doesn't fail yet. @@ -62,7 +65,7 @@ prop_sum_empty = property $ genRank $ \outrankm1@(SNat @nm1) -> do sht <- shuffleShR (0 :$: shtt) -- n n <- Gen.int (Range.linear 0 20) return (n :$: sht) -- n + 1 - guard (0 `elem` toList (shrTail sh)) + guard (0 `elem` shrTail sh) -- traceM ("sh: " ++ show sh ++ " -> " ++ show (product sh)) let arr = OR.fromList @(n + 1) @Double (toList sh) [] let rarr = rfromOrthotope inrank arr @@ -89,6 +92,10 @@ prop_sum_replicated doTranspose = property $ LTI -> return Refl -- actually we only continue if m < n _ -> discard (sh1, sh2, sh3) <- forAll $ genReplicatedShR inrank1 inrank2 + when debugCoverage $ do + label (LabelName ("rankdiff " ++ show (fromSNat' inrank2 - fromSNat' inrank1))) + label (LabelName ("size sh1 10^" ++ show (floor (logBase 10 (fromIntegral (shrSize sh1) :: Double)) :: Int))) + label (LabelName ("size sh3 10^" ++ show (floor (logBase 10 (fromIntegral (shrSize sh3) :: Double)) :: Int))) guard (all (> 0) sh3) arr <- forAllT $ OR.stretch (toList sh3) diff --git a/test/Tests/Permutation.hs b/test/Tests/Permutation.hs index 1e7ad13..98a6da5 100644 --- a/test/Tests/Permutation.hs +++ b/test/Tests/Permutation.hs @@ -6,7 +6,7 @@ module Tests.Permutation where import Data.Type.Equality -import Data.Array.Mixed.Permutation +import Data.Array.Nested.Permutation import Hedgehog import Hedgehog.Gen qualified as Gen diff --git a/test/Util.hs b/test/Util.hs index 34cf8ab..8a5ba72 100644 --- a/test/Util.hs +++ b/test/Util.hs @@ -15,7 +15,7 @@ import GHC.TypeLits import Hedgehog import Hedgehog.Internal.Property (failDiff) -import Data.Array.Mixed.Types (fromSNat') +import Data.Array.Nested.Types (fromSNat') -- Returns highest value that satisfies the predicate, or `lo` if none does |