Merge pull request haskell#10270 from haskell/wip/structured-hash-fix

tests: Make structured hash tests invariant to GHC version
geekosaur · Aug 25, 2024 · 4f50de3 · 4f50de3
2 parents 9b3ce92 + b90ccb3
commit 4f50de3
Show file tree

Hide file tree

Showing 3 changed files with 43 additions and 27 deletions.
diff --git a/Cabal-syntax/src/Distribution/Utils/Structured.hs b/Cabal-syntax/src/Distribution/Utils/Structured.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -418,12 +419,42 @@ instance Structured a => Structured (Ratio a) where structure = containerStructu
 instance Structured a => Structured [a] where structure = containerStructure
 instance Structured a => Structured (NonEmpty a) where structure = containerStructure
 
-instance (Structured a1, Structured a2) => Structured (a1, a2)
-instance (Structured a1, Structured a2, Structured a3) => Structured (a1, a2, a3)
-instance (Structured a1, Structured a2, Structured a3, Structured a4) => Structured (a1, a2, a3, a4)
-instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5) => Structured (a1, a2, a3, a4, a5)
-instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6) => Structured (a1, a2, a3, a4, a5, a6)
-instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6, Structured a7) => Structured (a1, a2, a3, a4, a5, a6, a7)
+-- These instances are defined directly because the generic names for tuples changed
+-- in 9.6 (https://gitlab.haskell.org/ghc/ghc/-/issues/24291).
+--
+-- By defining our own instances the STuple2 identifier will be used in the hash and
+-- hence the same on all GHC versions.
+
+data STuple2 a b = STuple2 a b deriving (Generic)
+data STuple3 a b c = STuple3 a b c deriving (Generic)
+data STuple4 a b c d = STuple4 a b c d deriving (Generic)
+data STuple5 a b c d e = STuple5 a b c d e deriving (Generic)
+data STuple6 a b c d e f = STuple6 a b c d e f deriving (Generic)
+data STuple7 a b c d e f g = STuple7 a b c d e f g deriving (Generic)
+
+instance (Structured a1, Structured a2) => Structured (STuple2 a1 a2)
+instance (Structured a1, Structured a2) => Structured (a1, a2) where
+  structure Proxy = structure @(STuple2 a1 a2) Proxy
+
+instance (Structured a1, Structured a2, Structured a3) => Structured (STuple3 a1 a2 a3)
+instance (Structured a1, Structured a2, Structured a3) => Structured (a1, a2, a3) where
+  structure Proxy = structure @(STuple3 a1 a2 a3) Proxy
+
+instance (Structured a1, Structured a2, Structured a3, Structured a4) => Structured (STuple4 a1 a2 a3 a4)
+instance (Structured a1, Structured a2, Structured a3, Structured a4) => Structured (a1, a2, a3, a4) where
+  structure Proxy = structure @(STuple4 a1 a2 a3 a4) Proxy
+
+instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5) => Structured (STuple5 a1 a2 a3 a4 a5)
+instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5) => Structured (a1, a2, a3, a4, a5) where
+  structure Proxy = structure @(STuple5 a1 a2 a3 a4 a5) Proxy
+
+instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6) => Structured (STuple6 a1 a2 a3 a4 a5 a6)
+instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6) => Structured (a1, a2, a3, a4, a5, a6) where
+  structure Proxy = structure @(STuple6 a1 a2 a3 a4 a5 a6) Proxy
+
+instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6, Structured a7) => Structured (STuple7 a1 a2 a3 a4 a5 a6 a7)
+instance (Structured a1, Structured a2, Structured a3, Structured a4, Structured a5, Structured a6, Structured a7) => Structured (a1, a2, a3, a4, a5, a6, a7) where
+  structure Proxy = structure @(STuple7 a1 a2 a3 a4 a5 a6 a7) Proxy
 
 instance Structured BS.ByteString where structure = nominalStructure
 instance Structured LBS.ByteString where structure = nominalStructure

diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
@@ -30,16 +30,8 @@ md5Check proxy md5Int = structureHash proxy @?= md5FromInteger md5Int
 
 md5CheckGenericPackageDescription :: Proxy GenericPackageDescription -> Assertion
 md5CheckGenericPackageDescription proxy = md5Check proxy
-#if MIN_VERSION_base(4,19,0)
-    0x62ad178a75f041af29947c9b3d83e6ed
-#else
-    0xba8f0baa8074fd238ad36a309399349e
-#endif
+    0xe40d8d67b85712f245354657d7a80165
 
 md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
 md5CheckLocalBuildInfo proxy = md5Check proxy
-#if MIN_VERSION_base(4,19,0)
-    0xc68e9c0758c4bf2d72fe82b3d55cee34
-#else
-    0xcf7e7bbcaec504d745fe086eec1786ff
-#endif
+    0xb0a61f1d93717a92b2b4ecbe0bc3abd4
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs b/cabal-install/tests/UnitTests/Distribution/Client/FileMonitor.hs
@@ -88,17 +88,10 @@ tests mtimeChange =
       Windows -> expectFailBecause msg
       _ -> id
     fingerprintStateGlob1, fingerprintStateGlob2, fingerprintStateFileSet1, fingerprintStateFileSet2 :: Word64
-#if MIN_VERSION_base(4,19,0)
-    fingerprintStateGlob1 = 0x4ebc6a7d12bb2132
-    fingerprintStateGlob2 = 0x2c2292eeda0a9319
-    fingerprintStateFileSet1 = 0x01df5796f9030851
-    fingerprintStateFileSet2 = 0x2f5c472be17bee98
-#else
-    fingerprintStateGlob1 = 0xf32c0d1644dd9ee5
-    fingerprintStateGlob2 = 0x0f2494f7b6031fb6
-    fingerprintStateFileSet1 = 0x06d4a13275c24282
-    fingerprintStateFileSet2 = 0x791b2a88684b5f37
-#endif
+    fingerprintStateGlob1 = 0x8d6292a27f48ab78
+    fingerprintStateGlob2 = 0xa69393cf17cb6c71
+    fingerprintStateFileSet1 = 0x441fcb5eaf403013
+    fingerprintStateFileSet2 = 0x129db82bba47f56f
 
 -- Check the file system behaves the way we expect it to