From 00cf72c64bbde698e99e53ea6c3ba6f14219cdb6 Mon Sep 17 00:00:00 2001 From: Arnaud Spiwack Date: Tue, 3 May 2022 15:53:44 +0200 Subject: [PATCH] Upgrade GHC to 9.2 + don't use `testProperty` from tasty-hedgehog MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit I've had to do both at the same time because I don't have a Stackage snapshot with GHC 9.0 and tasty-hedgehog 1.2. The `testProperty` function has been deprecated in the current 1.2 version. See https://github.com/qfpl/tasty-hedgehog/pull/42 for the reason. The `testProperty` function is replaced by `testPropertyNamed` which requires one extra argument (the name of the test function as a string). There were a test for which the property didn't have a name, so I had to name it. We also need `-XOverloadedString` in every module (some already have it). Upgrading the stack snapshot to GHC 9.2 didn't require any action. Upgrading the stack snapshot is part of #389. --- examples/Generic/Traverse.hs | 26 +++++++------ examples/Test/Foreign.hs | 11 +++--- examples/Test/Quicksort.hs | 6 ++- linear-base.cabal | 3 +- stack.yaml | 2 +- stack.yaml.lock | 8 ++-- test/Test/Data/Destination.hs | 11 +++--- test/Test/Data/Mutable/Array.hs | 41 ++++++++++---------- test/Test/Data/Mutable/HashMap.hs | 42 ++++++++++---------- test/Test/Data/Mutable/Set.hs | 30 ++++++++------- test/Test/Data/Mutable/Vector.hs | 64 ++++++++++++++++--------------- test/Test/Data/Polarized.hs | 21 +++++----- 12 files changed, 140 insertions(+), 125 deletions(-) diff --git a/examples/Generic/Traverse.hs b/examples/Generic/Traverse.hs index 62f098f7..2d8cb18e 100644 --- a/examples/Generic/Traverse.hs +++ b/examples/Generic/Traverse.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE LinearTypes #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} @@ -17,7 +18,7 @@ import Generics.Linear.TH import Hedgehog import Prelude.Linear import Test.Tasty -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Prelude data Pair a = MkPair a a @@ -31,18 +32,21 @@ instance Data.Functor Pair where instance Data.Traversable Pair where traverse = genericTraverse -pairTest :: TestTree -pairTest = - testProperty "traverse via genericTraverse with WithLog and Pair" $ - property $ - ( Data.traverse - (\x -> (Sum (1 :: Int), 2 * x)) - (MkPair 3 4 :: Pair Int) - ) - === (Sum 2, (MkPair 6 8)) - genericTraverseTests :: TestTree genericTraverseTests = testGroup "genericTraverse examples" [pairTest] + +pairTest :: TestTree +pairTest = + testPropertyNamed "traverse via genericTraverse with WithLog and Pair" "propertyPairTest" propertyPairTest + +propertyPairTest :: Property +propertyPairTest = + property $ + ( Data.traverse + (\x -> (Sum (1 :: Int), 2 * x)) + (MkPair 3 4 :: Pair Int) + ) + === (Sum 2, (MkPair 6 8)) diff --git a/examples/Test/Foreign.hs b/examples/Test/Foreign.hs index d3a4b84e..7706dde7 100644 --- a/examples/Test/Foreign.hs +++ b/examples/Test/Foreign.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LinearTypes #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -18,7 +19,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Prelude.Linear import Test.Tasty -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Prelude -- # Organizing tests @@ -36,16 +37,16 @@ listExampleTests :: TestTree listExampleTests = testGroup "list tests" - [ testProperty "List.toList . List.fromList = id" invertNonGCList, - testProperty "map id = id" mapIdNonGCList, - testProperty "memory freed post-exception" testExecptionOnMem + [ testPropertyNamed "List.toList . List.fromList = id" "invertNonGCList" invertNonGCList, + testPropertyNamed "map id = id" "mapIdNonGCList" mapIdNonGCList, + testPropertyNamed "memory freed post-exception" "testExecptionOnMem" testExecptionOnMem ] heapExampleTests :: TestTree heapExampleTests = testGroup "heap tests" - [testProperty "sort = heapsort" nonGCHeapSort] + [testPropertyNamed "sort = heapsort" "nonGCHeapSort" nonGCHeapSort] -- # Internal library ------------------------------------------------------------------------------- diff --git a/examples/Test/Quicksort.hs b/examples/Test/Quicksort.hs index a34aca60..f6915921 100644 --- a/examples/Test/Quicksort.hs +++ b/examples/Test/Quicksort.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Test.Quicksort (quickSortTests) where import Data.List (sort) @@ -6,10 +8,10 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Simple.Quicksort (quickSort) import Test.Tasty -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) quickSortTests :: TestTree -quickSortTests = testProperty "quicksort sorts" testQuicksort +quickSortTests = testPropertyNamed "quicksort sorts" "testQuicksort" testQuicksort testQuicksort :: Property testQuicksort = property $ do diff --git a/linear-base.cabal b/linear-base.cabal index 0808dbf9..4feecc87 100644 --- a/linear-base.cabal +++ b/linear-base.cabal @@ -183,8 +183,7 @@ test-suite examples base, linear-base, tasty, - tasty-hedgehog < 1.2, - -- tasty-hedgehog deprecates 'testProperty' in test/Test/Data/Destination.hs + tasty-hedgehog, hedgehog, storable-tuple, vector, diff --git a/stack.yaml b/stack.yaml index 25e60ad5..92cc9c7b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: nightly-2022-01-13 +resolver: nightly-2022-04-28 packages: - '.' extra-deps: diff --git a/stack.yaml.lock b/stack.yaml.lock index 45661b7b..83b956a0 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -34,7 +34,7 @@ packages: hackage: linear-generics-0.2@sha256:c1db1fcb96333be867978abfbed71e99dfbdcafa07d7d9642a89405e6bc971b1,5818 snapshots: - completed: - size: 621061 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/1/13.yaml - sha256: df0d2c3ff3cd0424bf178914a068d76f3e48c89edfdcf9b015698836a106b507 - original: nightly-2022-01-13 + size: 554661 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/4/28.yaml + sha256: eb778a9c971802e22068265fb7b14d357c3eb7d76229402b9444a3db1a2bc153 + original: nightly-2022-04-28 diff --git a/test/Test/Data/Destination.hs b/test/Test/Data/Destination.hs index ce338524..be7d6587 100644 --- a/test/Test/Data/Destination.hs +++ b/test/Test/Data/Destination.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Test.Data.Destination (destArrayTests) where @@ -9,7 +10,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Prelude.Linear import Test.Tasty -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Prelude -- # Tests and Utlities @@ -19,10 +20,10 @@ destArrayTests :: TestTree destArrayTests = testGroup "Destination array tests" - [ testProperty "alloc . mirror = id" roundTrip, - testProperty "alloc . replicate = V.replicate" replicateTest, - testProperty "alloc . fill = V.singleton" fillTest, - testProperty "alloc n . fromFunction (+s) = V.fromEnum n s" fromFuncEnum + [ testPropertyNamed "alloc . mirror = id" "roundTrip" roundTrip, + testPropertyNamed "alloc . replicate = V.replicate" "replicateTest" replicateTest, + testPropertyNamed "alloc . fill = V.singleton" "fillTest" fillTest, + testPropertyNamed "alloc n . fromFunction (+s) = V.fromEnum n s" "fromFuncEnum" fromFuncEnum ] list :: Gen [Int] diff --git a/test/Test/Data/Mutable/Array.hs b/test/Test/Data/Mutable/Array.hs index 6f186dbf..7152708d 100644 --- a/test/Test/Data/Mutable/Array.hs +++ b/test/Test/Data/Mutable/Array.hs @@ -30,7 +30,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Prelude.Linear as Linear hiding ((>)) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) -- # Exported Tests -------------------------------------------------------------------------------- @@ -41,30 +41,31 @@ mutArrTests = testGroup "Mutable array tests" group group :: [TestTree] group = -- All tests for exprs of the form (read (const ...) i) - [ testProperty "∀ s,i,x. read (alloc s x) i = x" readAlloc, - testProperty "∀ a,s,x,i. read (snd (allocBeside s x a)) i = x" allocBeside, - testProperty "∀ s,a,i. i < length a, read (resize s 42 a) i = read a i" readResize, - testProperty "∀ a,i,x. read (write a i x) i = x " readWrite1, - testProperty "∀ a,i,j/=i,x. read (write a j x) i = read a i" readWrite2, + [ testPropertyNamed "∀ s,i,x. read (alloc s x) i = x" "readAlloc" readAlloc, + testPropertyNamed "∀ a,s,x,i. read (snd (allocBeside s x a)) i = x" "allocBeside" allocBeside, + testPropertyNamed "∀ s,a,i. i < length a, read (resize s 42 a) i = read a i" "readResize" readResize, + testPropertyNamed "∀ a,i,x. read (write a i x) i = x " "readWrite1" readWrite1, + testPropertyNamed "∀ a,i,j/=i,x. read (write a j x) i = read a i" "readWrite2" readWrite2, -- All tests for exprs of the form (length (const ...)) - testProperty "∀ s,x. len (alloc s x) = s" lenAlloc, - testProperty "∀ a,i,x. len (write a i x) = len a" lenWrite, - testProperty "∀ a,s,x. len (resize s x a) = s" lenResizeSeed, + testPropertyNamed "∀ s,x. len (alloc s x) = s" "lenAlloc" lenAlloc, + testPropertyNamed "∀ a,i,x. len (write a i x) = len a" "lenWrite" lenWrite, + testPropertyNamed "∀ a,s,x. len (resize s x a) = s" "lenResizeSeed" lenResizeSeed, -- Tests against a reference implementation - testProperty + testPropertyNamed "∀ a,ix. toList . write a ix = (\\l -> take ix l ++ [a] ++ drop (ix+1) l) . toList" + "writeRef" writeRef, - testProperty "∀ ix. read ix a = (toList a) !! i" readRef, - testProperty "size = length . toList" sizeRef, - testProperty "∀ a,s,x. resize s x a = take s (toList a ++ repeat x)" resizeRef, - testProperty "∀ s,n. slice s n = take s . drop n" sliceRef, - testProperty "f <$> fromList xs == fromList (f <$> xs)" refFmap, - testProperty "toList . fromList = id" refToListFromList, - testProperty "toList . freeze . fromList = id" refFreeze, - testProperty "dup2 produces identical arrays" refDupable, + testPropertyNamed "∀ ix. read ix a = (toList a) !! i" "readRef" readRef, + testPropertyNamed "size = length . toList" "sizeRef" sizeRef, + testPropertyNamed "∀ a,s,x. resize s x a = take s (toList a ++ repeat x)" "resizeRef" resizeRef, + testPropertyNamed "∀ s,n. slice s n = take s . drop n" "sliceRef" sliceRef, + testPropertyNamed "f <$> fromList xs == fromList (f <$> xs)" "refFmap" refFmap, + testPropertyNamed "toList . fromList = id" "refToListFromList" refToListFromList, + testPropertyNamed "toList . freeze . fromList = id" "refFreeze" refFreeze, + testPropertyNamed "dup2 produces identical arrays" "refDupable" refDupable, -- Regression tests - testProperty "do not reorder reads and writes" readAndWriteTest, - testProperty "do not evaluate values unnecesesarily" strictnessTest + testPropertyNamed "do not reorder reads and writes" "readAndWriteTest" readAndWriteTest, + testPropertyNamed "do not evaluate values unnecesesarily" "strictnessTest" strictnessTest ] -- # Internal Library diff --git a/test/Test/Data/Mutable/HashMap.hs b/test/Test/Data/Mutable/HashMap.hs index 90faf37f..7a6a62f4 100644 --- a/test/Test/Data/Mutable/HashMap.hs +++ b/test/Test/Data/Mutable/HashMap.hs @@ -37,7 +37,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Prelude.Linear as Linear import Test.Tasty -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) -- # Exported Tests -------------------------------------------------------------------------------- @@ -48,31 +48,33 @@ mutHMTests = testGroup "Mutable hashmap tests" group group :: [TestTree] group = [ -- Axiomatic tests - testProperty "∀ k,v,m. lookup k (insert m k v) = Just v" lookupInsert1, - testProperty + testPropertyNamed "∀ k,v,m. lookup k (insert m k v) = Just v" "lookupInsert1" lookupInsert1, + testPropertyNamed "∀ k,v,m,k'/=k. lookup k'(insert m k v) = lookup k' m" + "lookuInsert2" lookupInsert2, - testProperty "∀ k,m. lookup k (delete m k) = Nothing" lookupDelete1, - testProperty + testPropertyNamed "∀ k,m. lookup k (delete m k) = Nothing" "lookupDelete1" lookupDelete1, + testPropertyNamed "∀ k,m,k'/=k. lookup k' (delete m k) = lookup k' m" + "lookupDelete2" lookupDelete2, - testProperty "∀ k,v,m. member k (insert m k v) = True" memberInsert, - testProperty "∀ k,m. member k (delete m k) = False" memberDelete, - testProperty "∀ k,v,m. size (insert (m-k) k v) = 1+ size (m-k)" sizeInsert, - testProperty "∀ k,m with k. size (delete m k) + 1 = size m" deleteSize, + testPropertyNamed "∀ k,v,m. member k (insert m k v) = True" "memberInsert" memberInsert, + testPropertyNamed "∀ k,m. member k (delete m k) = False" "memberDelete" memberDelete, + testPropertyNamed "∀ k,v,m. size (insert (m-k) k v) = 1+ size (m-k)" "sizeInsert" sizeInsert, + testPropertyNamed "∀ k,m with k. size (delete m k) + 1 = size m" "deleteSize" deleteSize, -- Homorphism tests against a reference implementation - testProperty "insert k v h = fromList (toList h ++ [(k,v)])" refInsert, - testProperty "delete k h = fromList (filter (!= k . fst) (toList h))" refDelete, - testProperty "fst . lookup k h = lookup k (toList h)" refLookup, - testProperty "mapMaybe f h = fromList . mapMaybe (uncurry f) . toList" refMap, - testProperty "size = length . toList" refSize, - testProperty "toList . fromList = id" refToListFromList, - testProperty "filter f (fromList xs) = fromList (filter f xs)" refFilter, - testProperty "fromList xs <> fromList ys = fromList (xs <> ys)" refMappend, - testProperty "unionWith reference" refUnionWith, - testProperty "intersectionWith reference" refIntersectionWith, + testPropertyNamed "insert k v h = fromList (toList h ++ [(k,v)])" "refInsert" refInsert, + testPropertyNamed "delete k h = fromList (filter (!= k . fst) (toList h))" "refDelete" refDelete, + testPropertyNamed "fst . lookup k h = lookup k (toList h)" "refLookup" refLookup, + testPropertyNamed "mapMaybe f h = fromList . mapMaybe (uncurry f) . toList" "refMap" refMap, + testPropertyNamed "size = length . toList" "refSize" refSize, + testPropertyNamed "toList . fromList = id" "refToListFromList" refToListFromList, + testPropertyNamed "filter f (fromList xs) = fromList (filter f xs)" "refFilter" refFilter, + testPropertyNamed "fromList xs <> fromList ys = fromList (xs <> ys)" "refMappend" refMappend, + testPropertyNamed "unionWith reference" "refUnionWith" refUnionWith, + testPropertyNamed "intersectionWith reference" "refIntersectionWith" refIntersectionWith, -- Misc - testProperty "toList . shrinkToFit = toList" shrinkToFitTest + testPropertyNamed "toList . shrinkToFit = toList" "shrinkToFitTest" shrinkToFitTest ] -- # Internal Library diff --git a/test/Test/Data/Mutable/Set.hs b/test/Test/Data/Mutable/Set.hs index b4d33568..62a3967b 100644 --- a/test/Test/Data/Mutable/Set.hs +++ b/test/Test/Data/Mutable/Set.hs @@ -70,7 +70,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Prelude.Linear as Linear import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) -- # Exported Tests -------------------------------------------------------------------------------- @@ -81,23 +81,25 @@ mutSetTests = testGroup "Mutable set tests" group group :: [TestTree] group = -- Tests of the form [accessor (mutator)] - [ testProperty "∀ x. member (insert s x) x = True" memberInsert1, - testProperty "∀ x,y/=x. member (insert s x) y = member s y" memberInsert2, - testProperty "∀ x. member (delete s x) x = False" memberDelete1, - testProperty "∀ x,y/=x. member (delete s x) y = member s y" memberDelete2, - testProperty "∀ s, x \\in s. size (insert s x) = size s" sizeInsert1, - testProperty "∀ s, x \\notin s. size (insert s x) = size s + 1" sizeInsert2, - testProperty "∀ s, x \\in s. size (delete s x) = size s - 1" sizeDelete1, - testProperty "∀ s, x \\notin s. size (delete s x) = size s" sizeDelete2, + [ testPropertyNamed "∀ x. member (insert s x) x = True" "memberInsert1" memberInsert1, + testPropertyNamed "∀ x,y/=x. member (insert s x) y = member s y" "memberInsert2" memberInsert2, + testPropertyNamed "∀ x. member (delete s x) x = False" "memberDelete1" memberDelete1, + testPropertyNamed "∀ x,y/=x. member (delete s x) y = member s y" "memberDelete2" memberDelete2, + testPropertyNamed "∀ s, x \\in s. size (insert s x) = size s" "sizeInsert1" sizeInsert1, + testPropertyNamed "∀ s, x \\notin s. size (insert s x) = size s + 1" "sizeInsert2" sizeInsert2, + testPropertyNamed "∀ s, x \\in s. size (delete s x) = size s - 1" "sizeDelete1" sizeDelete1, + testPropertyNamed "∀ s, x \\notin s. size (delete s x) = size s" "sizeDelete2" sizeDelete2, -- Homomorphism tests - testProperty "sort . nub = sort . toList" toListFromList, - testProperty "member x s = elem x (toList s)" memberHomomorphism, - testProperty "size = length . toList" sizeHomomorphism, - testProperty + testPropertyNamed "sort . nub = sort . toList" "toListFromList" toListFromList, + testPropertyNamed "member x s = elem x (toList s)" "memberHomomorphism" memberHomomorphism, + testPropertyNamed "size = length . toList" "sizeHomomorphism" sizeHomomorphism, + testPropertyNamed "sort . nub ((toList s) ∪ (toList s')) = sort . toList (s ∪ s')" + "unionHomomorphism" unionHomomorphism, - testProperty + testPropertyNamed "sort . nub ((toList s) ∩ (toList s')) = sort . toList (s ∩ s')" + "intersecHomomorphism" intersectHomomorphism ] diff --git a/test/Test/Data/Mutable/Vector.hs b/test/Test/Data/Mutable/Vector.hs index cfd3c60b..8c7986c7 100644 --- a/test/Test/Data/Mutable/Vector.hs +++ b/test/Test/Data/Mutable/Vector.hs @@ -32,7 +32,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import qualified Prelude.Linear as Linear hiding ((>)) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) -- # Exported Tests -------------------------------------------------------------------------------- @@ -43,43 +43,45 @@ mutVecTests = testGroup "Mutable vector tests" group group :: [TestTree] group = -- All tests for exprs of the form (read (const ...) i) - [ testProperty "∀ s,i,x. read (constant s x) i = x" readConst, - testProperty "∀ a,i,x. read (write a i x) i = x " readWrite1, - testProperty "∀ a,i,j/=i,x. read (write a j x) i = read a i" readWrite2, - testProperty "∀ a,x,(i < len a). read (push a x) i = read a i" readPush1, - testProperty "∀ a,x. read (push a x) (len a) = x" readPush2, + [ testPropertyNamed "∀ s,i,x. read (constant s x) i = x" "readConst" readConst, + testPropertyNamed "∀ a,i,x. read (write a i x) i = x " "readWrite1" readWrite1, + testPropertyNamed "∀ a,i,j/=i,x. read (write a j x) i = read a i" "readWrite2" readWrite2, + testPropertyNamed "∀ a,x,(i < len a). read (push a x) i = read a i" "readPush1" readPush1, + testPropertyNamed "∀ a,x. read (push a x) (len a) = x" "readPush2" readPush2, -- All tests for exprs of the form (length (const ...)) - testProperty "∀ s,x. len (constant s x) = s" lenConst, - testProperty "∀ a,i,x. len (write a i x) = len a" lenWrite, - testProperty "∀ a,x. len (push a x) = 1 + len a" lenPush, + testPropertyNamed "∀ s,x. len (constant s x) = s" "lenConst" lenConst, + testPropertyNamed "∀ a,i,x. len (write a i x) = len a" "lenWrite" lenWrite, + testPropertyNamed "∀ a,x. len (push a x) = 1 + len a" "lenPush" lenPush, -- Tests against a reference implementation - testProperty + testPropertyNamed "write ix a v = (\\l -> take ix l ++ [a] ++ drop (ix+1) l) . toList" + "refWrite" refWrite, - testProperty "fst $ modify f ix v = snd $ f ((toList v) !! ix)" refModify1, - testProperty + testPropertyNamed "fst $ modify f ix v = snd $ f ((toList v) !! ix)" "refModify1" refModify1, + testPropertyNamed "snd (modify f i v) = write (toList v) i (fst (f ((toList v) !! i))))" + "refModify2" refModify2, - testProperty "toList . push x = snoc x . toList" refPush, - testProperty "toList . pop = init . toList" refPop, - testProperty "read ix v = (toList v) !! ix" refRead, - testProperty "size = length . toList" refSize, - testProperty "toList . shrinkToFit = toList" refShrinkToFit, - testProperty "pop . push _ = id" refPopPush, - testProperty "push . pop = id" refPushPop, - testProperty "slice s n = take s . drop n" refSlice, - testProperty "toList . fromList = id" refToListFromList, - testProperty "toList can be implemented with repeated pops" refToListViaPop, - testProperty "fromList can be implemented with repeated pushes" refFromListViaPush, - testProperty "toList works with extra capacity" refToListWithExtraCapacity, - testProperty "fromList xs <> fromList ys = fromList (xs <> ys)" refMappend, - testProperty "mapMaybe f (fromList xs) = fromList (mapMaybe f xs)" refMapMaybe, - testProperty "filter f (fromList xs) = fromList (filter f xs)" refFilter, - testProperty "f <$> fromList xs == fromList (f <$> xs)" refFmap, - testProperty "toList . freeze . fromList = id" refFreeze, + testPropertyNamed "toList . push x = snoc x . toList" "refPush" refPush, + testPropertyNamed "toList . pop = init . toList" "refPop" refPop, + testPropertyNamed "read ix v = (toList v) !! ix" "refRead" refRead, + testPropertyNamed "size = length . toList" "refSize" refSize, + testPropertyNamed "toList . shrinkToFit = toList" "refShrinkToFit" refShrinkToFit, + testPropertyNamed "pop . push _ = id" "refPopPush" refPopPush, + testPropertyNamed "push . pop = id" "refPushPop" refPushPop, + testPropertyNamed "slice s n = take s . drop n" "refSlice" refSlice, + testPropertyNamed "toList . fromList = id" "refToListFromList" refToListFromList, + testPropertyNamed "toList can be implemented with repeated pops" "refToListViaPop" refToListViaPop, + testPropertyNamed "fromList can be implemented with repeated pushes" "refFromListViaPush" refFromListViaPush, + testPropertyNamed "toList works with extra capacity" "refToListWithExtraCapacity" refToListWithExtraCapacity, + testPropertyNamed "fromList xs <> fromList ys = fromList (xs <> ys)" "refMappend" refMappend, + testPropertyNamed "mapMaybe f (fromList xs) = fromList (mapMaybe f xs)" "refMapMaybe" refMapMaybe, + testPropertyNamed "filter f (fromList xs) = fromList (filter f xs)" "refFilter" refFilter, + testPropertyNamed "f <$> fromList xs == fromList (f <$> xs)" "refFmap" refFmap, + testPropertyNamed "toList . freeze . fromList = id" "refFreeze" refFreeze, -- Regression tests - testProperty "push on an empty vector should succeed" snocOnEmptyVector, - testProperty "do not reorder reads and writes" readAndWriteTest + testPropertyNamed "push on an empty vector should succeed" "snocOnEmptyVector" snocOnEmptyVector, + testPropertyNamed "do not reorder reads and writes" "readAndWriteTest" readAndWriteTest ] -- # Internal Library diff --git a/test/Test/Data/Polarized.hs b/test/Test/Data/Polarized.hs index e258c8f1..faad46c1 100644 --- a/test/Test/Data/Polarized.hs +++ b/test/Test/Data/Polarized.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-} module Test.Data.Polarized (polarizedArrayTests) where @@ -11,7 +12,7 @@ import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Prelude.Linear import Test.Tasty -import Test.Tasty.Hedgehog (testProperty) +import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Prelude {- TODO: @@ -28,15 +29,15 @@ polarizedArrayTests :: TestTree polarizedArrayTests = testGroup "Polarized arrays" - [ testProperty "Push.alloc . transfer . Pull.fromVector = id" polarRoundTrip, - testProperty "Push.append ~ Vec.append" pushAppend, - testProperty "Push.make ~ Vec.replicate" pushMake, - testProperty "Pull.append ~ Vec.append" pullAppend, - testProperty "Pull.asList . Pull.fromVector ~ id" pullAsList, - testProperty "Pull.singleton x = [x]" pullSingleton, - testProperty "Pull.splitAt ~ splitAt" pullSplitAt, - testProperty "Pull.make ~ Vec.replicate" pullMake, - testProperty "Pull.zip ~ zip" pullZip + [ testPropertyNamed "Push.alloc . transfer . Pull.fromVector = id" "polarRoundTrip" polarRoundTrip, + testPropertyNamed "Push.append ~ Vec.append" "pushAppend" pushAppend, + testPropertyNamed "Push.make ~ Vec.replicate" "pushMake" pushMake, + testPropertyNamed "Pull.append ~ Vec.append" "pullAppend" pullAppend, + testPropertyNamed "Pull.asList . Pull.fromVector ~ id" "pullAsList" pullAsList, + testPropertyNamed "Pull.singleton x = [x]" "pullSingleton" pullSingleton, + testPropertyNamed "Pull.splitAt ~ splitAt" "pullSplitAt" pullSplitAt, + testPropertyNamed "Pull.make ~ Vec.replicate" "pullMake" pullMake, + testPropertyNamed "Pull.zip ~ zip" "pullZip" pullZip ] list :: Gen [Int]