Skip to content
Snippets Groups Projects
Commit b2a36b7b authored by Artem Pelenitsyn's avatar Artem Pelenitsyn Committed by Mikolaj
Browse files

GHC 9.8 compat: update hashes of data structures as computed by Structured

It seems, GHC 9.8 changed something in the code generation for data types.
Structured class is supposed to catch such cases.
parent 0cac1f3a
No related branches found
No related tags found
No related merge requests found
......@@ -25,7 +25,12 @@ tests = testGroup "Distribution.Utils.Structured"
, testCase "SPDX.License" $
md5Check (Proxy :: Proxy License) 0xd3d4a09f517f9f75bc3d16370d5a853a
-- The difference is in encoding of newtypes
#if MIN_VERSION_base(4,7,0)
#if MIN_VERSION_base(4,19,0)
, testCase "GenericPackageDescription" $
md5Check (Proxy :: Proxy GenericPackageDescription) 0xf5fdb32b43aca790192f44d9ecaa9689
, testCase "LocalBuildInfo" $
md5Check (Proxy :: Proxy LocalBuildInfo) 0x205fbe2649bc5e488bce50c07a71cadb
#elif MIN_VERSION_base(4,7,0)
, testCase "GenericPackageDescription" $
md5Check (Proxy :: Proxy GenericPackageDescription) 0xb287a6f04e34ef990cdd15bc6cb01c76
, testCase "LocalBuildInfo" $
......
{-# LANGUAGE CPP #-}
module UnitTests.Distribution.Client.FileMonitor (tests) where
import Distribution.Parsec (simpleParsec)
......@@ -31,8 +33,8 @@ tests mtimeChange =
[ testGroup
"Structured hashes"
[ testCase "MonitorStateFile" $ structureHash (Proxy :: Proxy MonitorStateFile) @?= Fingerprint 0xe4108804c34962f6 0x06e94f8fc9e48e13
, testCase "MonitorStateGlob" $ structureHash (Proxy :: Proxy MonitorStateGlob) @?= Fingerprint 0xfd8f6be0e8258fe7 0xdb5fac737139bca6
, testCase "MonitorStateFileSet" $ structureHash (Proxy :: Proxy MonitorStateFileSet) @?= Fingerprint 0xb745f4ea498389a5 0x70db6adb5078aa27
, testCase "MonitorStateGlob" $ structureHash (Proxy :: Proxy MonitorStateGlob) @?= Fingerprint fingerprintStateGlob1 fingerprintStateGlob2
, testCase "MonitorStateFileSet" $ structureHash (Proxy :: Proxy MonitorStateFileSet) @?= Fingerprint fingerprintStateFileSet1 fingerprintStateFileSet2
]
, testCase "sanity check mtimes" $ testFileMTimeSanity mtimeChange
, testCase "sanity check dirs" $ testDirChangeSanity mtimeChange
......@@ -85,6 +87,18 @@ tests mtimeChange =
knownBrokenInWindows msg = case buildOS of
Windows -> expectFailBecause msg
_ -> id
fingerprintStateGlob1, fingerprintStateGlob2, fingerprintStateFileSet1, fingerprintStateFileSet2 :: Word64
#if MIN_VERSION_base(4,19,0)
fingerprintStateGlob1 = 0xae70229aabb1ba1f
fingerprintStateGlob2 = 0xb53ed324c96f0d0d
fingerprintStateFileSet1 = 0x8e509e16f973e036
fingerprintStateFileSet2 = 0xa23f21d8dc8a2dee
#else
fingerprintStateGlob1 = 0xfd8f6be0e8258fe7
fingerprintStateGlob2 = 0xdb5fac737139bca6
fingerprintStateFileSet1 = 0xb745f4ea498389a5
fingerprintStateFileSet2 = 0x70db6adb5078aa27
#endif
-- Check the file system behaves the way we expect it to
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment