Upgrade GHC to 9.2 + don't use testProperty from tasty-hedgehog

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 qfpl/tasty-hedgehog#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.
tweag · May 3, 2022 · 00cf72c · 00cf72c
1 parent 113a758
commit 00cf72c
Show file tree

Hide file tree

Showing 12 changed files with 140 additions and 125 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
   ]