diff options
Diffstat (limited to 'test/Tests/C.hs')
| -rw-r--r-- | test/Tests/C.hs | 23 |
1 files changed, 15 insertions, 8 deletions
diff --git a/test/Tests/C.hs b/test/Tests/C.hs index a0f103d..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.Internal.Property (forAllT) import Hedgehog.Gen qualified as Gen +import Hedgehog.Internal.Property (LabelName(..), forAllT) import Hedgehog.Range qualified as Range import Test.Tasty import Test.Tasty.Hedgehog @@ -39,13 +39,16 @@ 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. let inrank = SNat @(n + 1) sh <- forAll $ genShR inrank -- traceM ("sh: " ++ show sh ++ " -> " ++ show (product sh)) - guard (all (> 0) (toList (shrTail sh))) -- only constrain the tail + guard (all (> 0) (shrTail sh)) -- only constrain the tail arr <- forAllT $ OR.fromVector @Double @(n + 1) (toList sh) <$> genStorables (Range.singleton (product sh)) (\w -> fromIntegral w / fromIntegral (maxBound :: Word64)) @@ -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 (any (== 0) (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 @@ -72,7 +75,7 @@ prop_sum_lasteq1 :: Property prop_sum_lasteq1 = property $ genRank $ \outrank@(SNat @n) -> do let inrank = SNat @(n + 1) outsh <- forAll $ genShR outrank - guard (all (> 0) (toList outsh)) + guard (all (> 0) outsh) let insh = shrAppend outsh (1 :$: ZSR) arr <- forAllT $ OR.fromVector @Double @(n + 1) (toList insh) <$> genStorables (Range.singleton (product insh)) @@ -89,7 +92,11 @@ prop_sum_replicated doTranspose = property $ LTI -> return Refl -- actually we only continue if m < n _ -> discard (sh1, sh2, sh3) <- forAll $ genReplicatedShR inrank1 inrank2 - guard (all (> 0) (toList sh3)) + 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) . OR.reshape (toList sh2) @@ -111,7 +118,7 @@ prop_negate_with :: forall f b. Show b prop_negate_with genRank' genB preproc = property $ genRank' $ \extra rank@(SNat @n) -> do sh <- forAll $ genShR rank - guard (all (> 0) (toList sh)) + guard (all (> 0) sh) arr <- forAllT $ OR.fromVector @Double @n (toList sh) <$> genStorables (Range.singleton (product sh)) (\w -> fromIntegral w / fromIntegral (maxBound :: Word64)) |