Skip to content

Commit 3b0253c

Browse files
ShimuuarShimuuar
committed
Rework conditional compilation
Let keep test for older GHC but ignore their failures
1 parent 4a8b36b commit 3b0253c

File tree

3 files changed

+111
-66
lines changed

3 files changed

+111
-66
lines changed

‎vector/tests-inspect/Inspect/Alloc.hs‎

Lines changed: 66 additions & 66 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,17 @@
11
{-# LANGUAGE BangPatterns #-}
22
{-# LANGUAGE CPP #-}
3+
{-# LANGUAGE LambdaCase #-}
34
{-# LANGUAGE ScopedTypeVariables #-}
45
{-# LANGUAGE TypeApplications #-}
56
{- |
67
Here we test that GHC is able to optimize well construction of vector
78
using monadic\/applicative actions. Well is understood as able to
89
generate code which does not allocate except for buffer and some
910
constant overhead.
11+
12+
This is test for GHC optimizer as well and older version fail this
13+
test. Thus we have to disable them. However we expect (or rather
14+
hope) that no regressions will appear in future versions.
1015
-}
1116
module Inspect.Alloc where
1217

@@ -21,33 +26,31 @@ import Test.Tasty
2126
import Test.Tasty.HUnit
2227
import System.Mem
2328
import Test.Alloc
29+
import Test.Ignore
2430

2531
import qualified Data.Vector.Unboxed as VU
2632
import Inspect.Fusion
2733

34+
35+
minGHC :: Int -> TestTree -> TestTree
36+
minGHC n test
37+
| ghcVersion >= n = test
38+
| otherwise = ignoreTest test
39+
where
40+
ghcVersion = __GLASGOW_HASKELL__ :: Int
41+
2842
tests :: TestTree
2943
tests = testGroup "allocations"
3044
[ testGroup "traversable"
3145
[ testCase "IO"
3246
$ checkAllocations (linear 8)
3347
$ whnfIO (VU.traverse (\_ -> getAllocationCounter) vector)
34-
35-
#if MIN_VERSION_base(4,17,0)
36-
-- GHC<9.4 doesn't optimize well.
37-
, testCase "ST"
48+
, minGHC 904 $ testCase "ST"
3849
$ checkAllocations (linear 8)
3950
$ (\v -> runST $ VU.traverse (pureST . fromIntegral) v) `whnf` vector
40-
#endif
41-
42-
#if MIN_VERSION_base(4,15,0)
43-
-- GHC<9.0 doesn't optimize this well. And there's no appetite
44-
-- for finding out why. Thus it's disabled for them. We'll still
45-
-- catch regression going forward.
4651
, testCase "Identity"
4752
$ checkAllocations (linear 8)
4853
$ VU.traverse (\n -> Identity (10*n)) `whnf` vector
49-
#endif
50-
5154
-- NOTE: Naive traversal is lazy and allocated 2 words per element
5255
--
5356
-- , testCase "Const Sum"
@@ -58,14 +61,11 @@ tests = testGroup "allocations"
5861
[ testCase "IO"
5962
$ checkAllocations (linear 8)
6063
$ whnfIO (VU.replicateM size getAllocationCounter)
61-
62-
#if MIN_VERSION_base(4,17,0)
63-
-- GHC<9.4 doesn't optimize well.
64-
, testCase "ST"
64+
, minGHC 904 $ testCase "ST"
6565
$ checkAllocations (linear 8)
6666
$ (\sz -> runST $ VU.generateM sz pureST) `whnf` size
67-
#endif
68-
67+
-- NOTE: No rewrite rule for Identity
68+
--
6969
-- , testCase "Identity"
7070
-- $ checkAllocations (linear 8)
7171
-- $ (\sz -> VU.generateM sz (\n -> Identity (fromIntegral n :: Int64))) `whnf` size
@@ -86,61 +86,61 @@ tests = testGroup "allocations"
8686
, allocWHNF "test_indexed" test_indexed vectorI
8787
]
8888
, testGroup "producers"
89-
[ allocWHNF "test_replicate" test_replicate size
90-
, allocWHNF "test_generate" test_generate size
91-
, allocWHNF "test_iterateN" test_iterateN size
92-
, allocWHNF "test_unfoldr" test_unfoldr size
93-
, allocWHNF "test_unfoldrN" test_unfoldrN size
94-
, allocWHNF "test_enumFromN" test_enumFromN size
95-
, allocWHNF "test_enumFromStepN" test_enumFromStepN size
96-
97-
, allocWHNF "test_enumFromTo[Int]" (test_enumFromTo @Int fromIntegral 0) 100000
98-
, allocWHNF "test_enumFromTo[Int64]" (test_enumFromTo @Int64 fromIntegral 0) 100000
99-
, allocWHNF "test_enumFromTo[Int32]" (test_enumFromTo @Int32 fromIntegral 0) 100000
100-
, allocWHNF "test_enumFromTo[Int16]" (test_enumFromTo @Int16 fromIntegral 0) maxBound
101-
, allocWHNF "test_enumFromTo[Word]" (test_enumFromTo @Word fromIntegral 0) 100000
102-
, allocWHNF "test_enumFromTo[Word64]" (test_enumFromTo @Word64 fromIntegral 0) 100000
103-
, allocWHNF "test_enumFromTo[Word32]" (test_enumFromTo @Word32 fromIntegral 0) 100000
104-
, allocWHNF "test_enumFromTo[Word16]" (test_enumFromTo @Word16 fromIntegral 0) maxBound
105-
, allocWHNF "test_enumFromTo[Float]" (test_enumFromTo @Float round 0) 100000
106-
, allocWHNF "test_enumFromTo[Double]" (test_enumFromTo @Double round 0) 100000
107-
, allocWHNF "test_enumFromTo[Char]" (test_enumFromTo @Char ord (chr 32)) (chr 8000)
89+
[ allocWHNF "test_replicate" test_replicate size
90+
, allocWHNF "test_generate" test_generate size
91+
, allocWHNF "test_iterateN" test_iterateN size
92+
, allocWHNF "test_unfoldr" test_unfoldr size
93+
, allocWHNF "test_unfoldrN" test_unfoldrN size
94+
, allocWHNF "test_enumFromN" test_enumFromN size
95+
, allocWHNF "test_enumFromStepN" test_enumFromStepN size
96+
97+
, allocWHNF "test_enumFromTo[Int]" (test_enumFromTo @Int fromIntegral 0) 100000
98+
, allocWHNF "test_enumFromTo[Int64]" (test_enumFromTo @Int64 fromIntegral 0) 100000
99+
, allocWHNF "test_enumFromTo[Int32]" (test_enumFromTo @Int32 fromIntegral 0) 100000
100+
, allocWHNF "test_enumFromTo[Int16]" (test_enumFromTo @Int16 fromIntegral 0) maxBound
101+
, allocWHNF "test_enumFromTo[Word]" (test_enumFromTo @Word fromIntegral 0) 100000
102+
, allocWHNF "test_enumFromTo[Word64]" (test_enumFromTo @Word64 fromIntegral 0) 100000
103+
, allocWHNF "test_enumFromTo[Word32]" (test_enumFromTo @Word32 fromIntegral 0) 100000
104+
, allocWHNF "test_enumFromTo[Word16]" (test_enumFromTo @Word16 fromIntegral 0) maxBound
105+
, allocWHNF "test_enumFromTo[Float]" (test_enumFromTo @Float round 0) 100000
106+
, allocWHNF "test_enumFromTo[Double]" (test_enumFromTo @Double round 0) 100000
107+
, allocWHNF "test_enumFromTo[Char]" (test_enumFromTo @Char ord (chr 32)) (chr 8000)
108108
-- FIXME: We don't have specializations for enumFromThenTo
109109
--
110110
-- , allocWHNF "test_enumFromThenTo" test_enumFromThenTo size
111111
]
112112
, testGroup "consumers"
113-
[ allocWHNF "test_bang" test_bang vectorI
114-
, allocWHNF "test_safeBang" test_safeBang vectorI
115-
, allocWHNF "test_head" test_head vectorI
116-
, allocWHNF "test_last" test_last vectorI
117-
, allocWHNF "test_unsafeHead" test_unsafeHead vectorI
118-
, allocWHNF "test_unsafeLast" test_unsafeLast vectorI
119-
, allocWHNF "test_indexM" test_indexM vectorI
120-
, allocWHNF "test_headM" test_headM vectorI
121-
, allocWHNF "test_lastM" test_lastM vectorI
122-
, allocWHNF "test_unsafeHeadM" test_unsafeHeadM vectorI
123-
, allocWHNF "test_unsafeLastM" test_unsafeLastM vectorI
113+
[ allocWHNF "test_bang" test_bang vectorI
114+
, allocWHNF "test_safeBang" test_safeBang vectorI
115+
, allocWHNF "test_head" test_head vectorI
116+
, allocWHNF "test_last" test_last vectorI
117+
, allocWHNF "test_unsafeHead" test_unsafeHead vectorI
118+
, allocWHNF "test_unsafeLast" test_unsafeLast vectorI
119+
, allocWHNF "test_indexM" test_indexM vectorI
120+
, allocWHNF "test_headM" test_headM vectorI
121+
, allocWHNF "test_lastM" test_lastM vectorI
122+
, allocWHNF "test_unsafeHeadM" test_unsafeHeadM vectorI
123+
, allocWHNF "test_unsafeLastM" test_unsafeLastM vectorI
124124
]
125125
, testGroup "update"
126-
[ allocVecWHNF "test_upd" (test_upd listUpd) vectorI
127-
, allocVecWHNF "test_update_1" (test_update_1 vectorIdx) vectorI
128-
, allocVecWHNF "test_update_2" (test_update_2 vectorI) vectorI
129-
, allocVecWHNF "test_update__1" (test_update__1 vectorI vectorI) vectorI
130-
, allocVecWHNF "test_update__2" (test_update__2 vectorI vectorI) vectorI
131-
, allocVecWHNF "test_update__3" (test_update__3 vectorI vectorI) vectorI
132-
, allocVecWHNF "test_unsafeUpdate_1" (test_unsafeUpdate_1 vectorIdx) vectorI
133-
, allocVecWHNF "test_unsafeUpdate_2" (test_unsafeUpdate_2 vectorI) vectorI
134-
, allocVecWHNF "test_unsafeUpdate__1" (test_unsafeUpdate__1 vectorI vectorI) vectorI
135-
, allocVecWHNF "test_unsafeUpdate__2" (test_unsafeUpdate__2 vectorI vectorI) vectorI
136-
, allocVecWHNF "test_unsafeUpdate__3" (test_unsafeUpdate__3 vectorI vectorI) vectorI
137-
, allocVecWHNF "test_accumulate_1" (test_accumulate_1 vectorIdx) vectorI
138-
, allocVecWHNF "test_accumulate_2" (test_accumulate_2 vectorI) vectorI
139-
, allocVecWHNF "test_accumulate__1" (test_accumulate__1 vectorI vectorI) vectorI
140-
, allocVecWHNF "test_accumulate__2" (test_accumulate__2 vectorI vectorI) vectorI
141-
, allocVecWHNF "test_accumulate__3" (test_accumulate__3 vectorI vectorI) vectorI
142-
, allocVecWHNF "test_unsafeAccumulate_1" (test_unsafeAccumulate_1 vectorIdx) vectorI
143-
, allocVecWHNF "test_unsafeAccumulate_2" (test_unsafeAccumulate_2 vectorI) vectorI
126+
[ allocVecWHNF "test_upd" (test_upd listUpd) vectorI
127+
, allocVecWHNF "test_update_1" (test_update_1 vectorIdx) vectorI
128+
, allocVecWHNF "test_update_2" (test_update_2 vectorI) vectorI
129+
, allocVecWHNF "test_update__1" (test_update__1 vectorI vectorI) vectorI
130+
, minGHC 904 $ allocVecWHNF "test_update__2" (test_update__2 vectorI vectorI) vectorI
131+
, allocVecWHNF "test_update__3" (test_update__3 vectorI vectorI) vectorI
132+
, allocVecWHNF "test_unsafeUpdate_1" (test_unsafeUpdate_1 vectorIdx) vectorI
133+
, allocVecWHNF "test_unsafeUpdate_2" (test_unsafeUpdate_2 vectorI) vectorI
134+
, allocVecWHNF "test_unsafeUpdate__1" (test_unsafeUpdate__1 vectorI vectorI) vectorI
135+
, minGHC 904 $ allocVecWHNF "test_unsafeUpdate__2" (test_unsafeUpdate__2 vectorI vectorI) vectorI
136+
, allocVecWHNF "test_unsafeUpdate__3" (test_unsafeUpdate__3 vectorI vectorI) vectorI
137+
, allocVecWHNF "test_accumulate_1" (test_accumulate_1 vectorIdx) vectorI
138+
, allocVecWHNF "test_accumulate_2" (test_accumulate_2 vectorI) vectorI
139+
, allocVecWHNF "test_accumulate__1" (test_accumulate__1 vectorI vectorI) vectorI
140+
, minGHC 904 $ allocVecWHNF "test_accumulate__2" (test_accumulate__2 vectorI vectorI) vectorI
141+
, allocVecWHNF "test_accumulate__3" (test_accumulate__3 vectorI vectorI) vectorI
142+
, allocVecWHNF "test_unsafeAccumulate_1" (test_unsafeAccumulate_1 vectorIdx) vectorI
143+
, minGHC 904 $ allocVecWHNF "test_unsafeAccumulate_2" (test_unsafeAccumulate_2 vectorI) vectorI
144144
, allocVecWHNF "test_unsafeAccumulate__1" (test_unsafeAccumulate__1 vectorI vectorI) vectorI
145145
, allocVecWHNF "test_unsafeAccumulate__2" (test_unsafeAccumulate__2 vectorI vectorI) vectorI
146146
, allocVecWHNF "test_unsafeAccumulate__3" (test_unsafeAccumulate__3 vectorI vectorI) vectorI

‎vector/tests-inspect/Test/Ignore.hs‎

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
{-# LANGUAGE GADTs #-}
2+
{-# LANGUAGE LambdaCase #-}
3+
{-# LANGUAGE RankNTypes #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeApplications #-}
6+
-- |
7+
module Test.Ignore
8+
( modifyTests
9+
, ignoreTest
10+
) where
11+
12+
import Data.Coerce
13+
import Test.Tasty
14+
import Test.Tasty.Runners
15+
import Test.Tasty.Providers
16+
17+
18+
data WithTest where
19+
WithTest :: IsTest t => t -> WithTest
20+
21+
modifyTests
22+
:: (forall a. (IsTest a) => a -> WithTest)
23+
-> TestTree -> TestTree
24+
modifyTests fun = go where
25+
go = \case
26+
SingleTest nm t -> case fun t of
27+
WithTest t' -> SingleTest nm t'
28+
TestGroup nm ts -> TestGroup nm (go <$> ts)
29+
PlusTestOptions plus tree -> PlusTestOptions plus (go tree)
30+
WithResource spec f -> WithResource spec (go . f)
31+
AskOptions f -> AskOptions (go . f)
32+
After d p t -> After d p (go t)
33+
34+
35+
ignoreTest :: TestTree -> TestTree
36+
ignoreTest = modifyTests (\t -> WithTest $ Ignored t)
37+
38+
newtype Ignored t = Ignored t
39+
40+
instance IsTest t => IsTest (Ignored t) where
41+
run ops (Ignored t) f = do
42+
_ <- run ops t f
43+
pure $ (testPassed ""){ resultShortDescription = "IGNORED" }
44+
testOptions = coerce (testOptions @t)

‎vector/vector.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -260,6 +260,7 @@ test-suite vector-inspection
260260
Inspect.DerivingVia.OtherFoo
261261
Test.Alloc
262262
Test.InspectExtra
263+
Test.Ignore
263264
build-depends:
264265
base -any
265266
, template-haskell

0 commit comments

Comments
 (0)