Skip to content

Commit 3cd7e25

Browse files
committed
Remove now redundant tests
1 parent 2dde880 commit 3cd7e25

File tree

2 files changed

+3
-77
lines changed

2 files changed

+3
-77
lines changed

containers-tests/containers-tests.cabal

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -402,7 +402,6 @@ test-suite map-strictness-properties
402402
CPP
403403

404404
other-modules:
405-
Utils.IsUnit
406405
Utils.Strictness
407406

408407
if impl(ghc >= 8.6)

containers-tests/tests/map-strictness.hs

Lines changed: 3 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -15,9 +15,8 @@ import qualified Data.List.NonEmpty as NE
1515
import Data.Ord (Down(..), comparing)
1616
import Data.Maybe (catMaybes, mapMaybe)
1717
import Data.Semigroup (Arg(..))
18-
import Test.ChasingBottoms.IsBottom
19-
import Test.Tasty (TestTree, TestName, defaultMain, testGroup)
20-
import Test.Tasty.HUnit
18+
import Test.ChasingBottoms.IsBottom (bottom, isBottom)
19+
import Test.Tasty (TestTree, defaultMain, testGroup)
2120
import Test.Tasty.QuickCheck (testProperty)
2221
import Test.QuickCheck
2322
import Test.QuickCheck.Function
@@ -32,9 +31,9 @@ import qualified Data.Map.Merge.Lazy as LMerge
3231
import Data.Set (Set)
3332
import qualified Data.Set as Set
3433

35-
import Utils.IsUnit
3634
import Utils.Strictness
3735
(Bot(..), Func(..), Func2(..), Func3(..), applyFunc, applyFunc2, applyFunc3)
36+
3837
#if __GLASGOW_HASKELL__ >= 806
3938
import Utils.NoThunks
4039
#endif
@@ -998,74 +997,6 @@ pStrictFoldlWithKey' :: Map Int Int -> Property
998997
pStrictFoldlWithKey' m = whnfHasNoThunks (M.foldlWithKey' (\as _ a -> a : as) [] m)
999998
#endif
1000999

1001-
#if __GLASGOW_HASKELL__ >= 806
1002-
pStrictFromDistinctAscList :: [Int] -> Property
1003-
pStrictFromDistinctAscList = whnfHasNoThunks . evalSpine . M.elems . M.fromDistinctAscList . zip [0::Int ..] . map (Just $!)
1004-
where
1005-
evalSpine xs = length xs `seq` xs
1006-
#endif
1007-
1008-
#if __GLASGOW_HASKELL__ >= 806
1009-
pStrictFromDistinctDescList :: [Int] -> Property
1010-
pStrictFromDistinctDescList = whnfHasNoThunks . evalSpine . M.elems . M.fromDistinctDescList . zip [0::Int, -1 ..] . map (Just $!)
1011-
where
1012-
evalSpine xs = length xs `seq` xs
1013-
#endif
1014-
1015-
------------------------------------------------------------------------
1016-
-- check for extra thunks
1017-
--
1018-
-- These tests distinguish between `()`, a fully evaluated value, and
1019-
-- things like `id ()` which are extra thunks that should be avoided
1020-
-- in most cases. An exception is `L.fromListWith const`, which cannot
1021-
-- evaluate the `const` calls.
1022-
1023-
tExtraThunksM :: TestTree
1024-
tExtraThunksM = testGroup "Map.Strict - extra thunks" $
1025-
if not isUnitSupported then [] else
1026-
-- for strict maps, all the values should be evaluated to ()
1027-
[ check "singleton" $ m0
1028-
, check "insert" $ M.insert 42 () m0
1029-
, check "insertWith" $ M.insertWith const 42 () m0
1030-
, check "fromList" $ M.fromList [(42,()),(42,())]
1031-
, check "fromListWith" $ M.fromListWith const [(42,()),(42,())]
1032-
, check "fromAscList" $ M.fromAscList [(42,()),(42,())]
1033-
, check "fromAscListWith" $ M.fromAscListWith const [(42,()),(42,())]
1034-
, check "fromDistinctAscList" $ M.fromAscList [(42,())]
1035-
]
1036-
where
1037-
m0 = M.singleton 42 ()
1038-
check :: TestName -> Map Int () -> TestTree
1039-
check n m = testCase n $ case M.lookup 42 m of
1040-
Just v -> assertBool msg (isUnit v)
1041-
_ -> assertBool "key not found" False
1042-
where
1043-
msg = "too lazy -- expected fully evaluated ()"
1044-
1045-
tExtraThunksL :: TestTree
1046-
tExtraThunksL = testGroup "Map.Lazy - extra thunks" $
1047-
if not isUnitSupported then [] else
1048-
-- for lazy maps, the *With functions should leave `const () ()` thunks,
1049-
-- but the other functions should produce fully evaluated ().
1050-
[ check "singleton" True $ m0
1051-
, check "insert" True $ L.insert 42 () m0
1052-
, check "insertWith" False $ L.insertWith const 42 () m0
1053-
, check "fromList" True $ L.fromList [(42,()),(42,())]
1054-
, check "fromListWith" False $ L.fromListWith const [(42,()),(42,())]
1055-
, check "fromAscList" True $ L.fromAscList [(42,()),(42,())]
1056-
, check "fromAscListWith" False $ L.fromAscListWith const [(42,()),(42,())]
1057-
, check "fromDistinctAscList" True $ L.fromAscList [(42,())]
1058-
]
1059-
where
1060-
m0 = L.singleton 42 ()
1061-
check :: TestName -> Bool -> L.Map Int () -> TestTree
1062-
check n e m = testCase n $ case L.lookup 42 m of
1063-
Just v -> assertBool msg (e == isUnit v)
1064-
_ -> assertBool "key not found" False
1065-
where
1066-
msg | e = "too lazy -- expected fully evaluated ()"
1067-
| otherwise = "too strict -- expected a thunk"
1068-
10691000
------------------------------------------------------------------------
10701001
-- * Test list
10711002

@@ -1097,12 +1028,8 @@ tests =
10971028
, testProperty "strict foldl'" pStrictFoldl'
10981029
, testProperty "strict foldrWithKey'" pStrictFoldrWithKey'
10991030
, testProperty "strict foldlWithKey'" pStrictFoldlWithKey'
1100-
, testProperty "strict fromDistinctAscList" pStrictFromDistinctAscList
1101-
, testProperty "strict fromDistinctDescList" pStrictFromDistinctDescList
11021031
#endif
11031032
]
1104-
, tExtraThunksM
1105-
, tExtraThunksL
11061033
, testGroup "Map.Strict construction"
11071034
[ testProperty "singleton" prop_strictSingleton
11081035
, testProperty "fromSet" prop_strictFromSet

0 commit comments

Comments
 (0)