Skip to content

Commit e1017c8

Browse files
committed
Remove now redundant tests
1 parent 35eae26 commit e1017c8

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
@@ -987,74 +986,6 @@ pStrictFoldlWithKey' :: Map Int Int -> Property
987986
pStrictFoldlWithKey' m = whnfHasNoThunks (M.foldlWithKey' (\as _ a -> a : as) [] m)
988987
#endif
989988

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

@@ -1086,12 +1017,8 @@ tests =
10861017
, testProperty "strict foldl'" pStrictFoldl'
10871018
, testProperty "strict foldrWithKey'" pStrictFoldrWithKey'
10881019
, testProperty "strict foldlWithKey'" pStrictFoldlWithKey'
1089-
, testProperty "strict fromDistinctAscList" pStrictFromDistinctAscList
1090-
, testProperty "strict fromDistinctDescList" pStrictFromDistinctDescList
10911020
#endif
10921021
]
1093-
, tExtraThunksM
1094-
, tExtraThunksL
10951022

10961023
, testGroup "Map.Strict construction"
10971024
[ testProperty "singleton" prop_strictSingleton

0 commit comments

Comments
 (0)