diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/Gen.hs | 7 | ||||
| -rw-r--r-- | test/Tests/C.hs | 39 |
2 files changed, 22 insertions, 24 deletions
diff --git a/test/Gen.hs b/test/Gen.hs index 4f5fe96..789a59c 100644 --- a/test/Gen.hs +++ b/test/Gen.hs @@ -11,7 +11,6 @@ module Gen where import Data.ByteString qualified as BS -import Data.Foldable (toList) import Data.Type.Equality import Data.Type.Ord import Data.Vector.Storable qualified as VS @@ -46,7 +45,7 @@ genLowBiased (lo, hi) = do return (lo + x * x * x * (hi - lo)) shuffleShR :: IShR n -> Gen (IShR n) -shuffleShR = \sh -> go (length sh) (toList sh) sh +shuffleShR = \sh -> go (shrLength sh) (shrToList sh) sh where go :: Int -> [Int] -> IShR n -> Gen (IShR n) go _ _ ZSR = return ZSR @@ -78,7 +77,7 @@ genShRwithTarget targetMax sn = do dims <- genDims m (if dim == 0 then 0 else tgt `div` dim) return (dim :$: dims) dims <- genDims sn targetSize - let maxdim = maximum dims + let maxdim = maximum $ shrToList dims cap = binarySearch (`div` 2) 1 maxdim (\cap' -> shrSize (min cap' <$> dims) <= targetSize) shuffleShR (min cap <$> dims) @@ -139,7 +138,7 @@ genStaticShX = \n k -> case n of genStaticShX n' $ \ssh -> k (item :!% ssh) where - genItem :: Monad m => (forall n. SMayNat () SNat n -> PropertyT m ()) -> PropertyT m () + genItem :: Monad m => (forall n. SMayNat () n -> PropertyT m ()) -> PropertyT m () genItem k = do b <- forAll Gen.bool if b diff --git a/test/Tests/C.hs b/test/Tests/C.hs index 0656107..8703957 100644 --- a/test/Tests/C.hs +++ b/test/Tests/C.hs @@ -15,7 +15,6 @@ module Tests.C where import Control.Monad import Data.Array.RankedS qualified as OR -import Data.Foldable (toList) import Data.Functor.Const import Data.Type.Equality import Foreign @@ -50,10 +49,10 @@ 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) (shrTail sh)) -- only constrain the tail - arr <- forAllT $ OR.fromVector @Double @(n + 1) (toList sh) <$> - genStorables (Range.singleton (product sh)) + -- traceM ("sh: " ++ show sh ++ " -> " ++ show (shrSize sh)) + guard (all (> 0) (shrToList $ shrTail sh)) -- only constrain the tail + arr <- forAllT $ OR.fromVector @Double @(n + 1) (shrToList sh) <$> + genStorables (Range.singleton (shrSize sh)) (\w -> fromIntegral w / fromIntegral (maxBound :: Word64)) let rarr = rfromOrthotope inrank arr almostEq fineTol (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr) @@ -68,9 +67,9 @@ 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` shrTail sh) - -- traceM ("sh: " ++ show sh ++ " -> " ++ show (product sh)) - let arr = OR.fromList @(n + 1) @Double (toList sh) [] + guard (0 `elem` (shrToList $ shrTail sh)) + -- traceM ("sh: " ++ show sh ++ " -> " ++ show (shrSize sh)) + let arr = OR.fromList @(n + 1) @Double (shrToList sh) [] let rarr = rfromOrthotope inrank arr OR.toList (rtoOrthotope (rsumOuter1Prim rarr)) === [] @@ -78,10 +77,10 @@ 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) outsh) + guard (all (> 0) $ shrToList outsh) let insh = shrAppend outsh (1 :$: ZSR) - arr <- forAllT $ OR.fromVector @Double @(n + 1) (toList insh) <$> - genStorables (Range.singleton (product insh)) + arr <- forAllT $ OR.fromVector @Double @(n + 1) (shrToList insh) <$> + genStorables (Range.singleton (shrSize insh)) (\w -> fromIntegral w / fromIntegral (maxBound :: Word64)) let rarr = rfromOrthotope inrank arr almostEq fineTol (rtoOrthotope (rsumOuter1Prim rarr)) (orSumOuter1 outrank arr) @@ -99,12 +98,12 @@ prop_sum_replicated doTranspose = property $ 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) + guard (all (> 0) $ shrToList sh3) arr <- forAllT $ - OR.stretch (toList sh3) - . OR.reshape (toList sh2) - . OR.fromVector @Double @m (toList sh1) <$> - genStorables (Range.singleton (product sh1)) + OR.stretch (shrToList sh3) + . OR.reshape (shrToList sh2) + . OR.fromVector @Double @m (shrToList sh1) <$> + genStorables (Range.singleton (shrSize sh1)) (\w -> fromIntegral w / fromIntegral (maxBound :: Word64)) arrTrans <- if doTranspose then do perm <- forAll $ genPermR (fromSNat' inrank2) @@ -121,9 +120,9 @@ 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) sh) - arr <- forAllT $ OR.fromVector @Double @n (toList sh) <$> - genStorables (Range.singleton (product sh)) + guard (all (> 0) $ shrToList sh) + arr <- forAllT $ OR.fromVector @Double @n (shrToList sh) <$> + genStorables (Range.singleton (shrSize sh)) (\w -> fromIntegral w / fromIntegral (maxBound :: Word64)) bval <- forAll $ genB extra sh let arr' = preproc extra bval arr @@ -156,7 +155,7 @@ tests = testGroup "C" (\_ sh -> do let genPair n = do lo <- Gen.integral (Range.constant 0 (n-1)) len <- Gen.integral (Range.constant 0 (n-lo-1)) return (lo, len) - pairs <- mapM genPair (toList sh) + pairs <- mapM genPair (shrToList sh) return pairs) (\_ -> OR.slice) ] |