[Git][ghc/ghc][master] 2 commits: testsuite: Add testcase for #18733
Marge Bot
gitlab at gitlab.haskell.org
Fri Nov 13 19:29:06 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
787e93ae by Ben Gamari at 2020-11-11T23:14:11-05:00
testsuite: Add testcase for #18733
- - - - -
5353fd50 by Ben Gamari at 2020-11-12T10:05:30-05:00
compiler: Fix recompilation checking
In ticket #18733 we noticed a rather serious deficiency in the current
fingerprinting logic for recursive groups. I have described the old
fingerprinting story and its problems in Note [Fingerprinting recursive
groups] and have reworked the story accordingly to avoid these issues.
Fixes #18733.
- - - - -
7 changed files:
- compiler/GHC/Iface/Recomp.hs
- + testsuite/tests/driver/T18733/Library1.hs
- + testsuite/tests/driver/T18733/Library2.hs
- + testsuite/tests/driver/T18733/Main.hs
- + testsuite/tests/driver/T18733/Makefile
- + testsuite/tests/driver/T18733/T18733.stdout
- + testsuite/tests/driver/T18733/all.T
Changes:
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -65,6 +65,7 @@ import Data.Function
import Data.List (find, sortBy, sort)
import qualified Data.Map as Map
import qualified Data.Set as Set
+import Data.Word (Word64)
--Qualified import so we can define a Semigroup instance
-- but it doesn't clash with Outputable.<>
@@ -729,6 +730,77 @@ Names (e.g. the ifName field of a IfaceDecl) and non-binding (e.g. the ifInstCls
field of a IfaceClsInst): only in the non-binding case should we include the
fingerprint; in the binding case we shouldn't since it is merely the name of the
thing that we are currently fingerprinting.
+
+
+Note [Fingerprinting recursive groups]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The fingerprinting of a single recursive group is a rather subtle affair, as
+seen in #18733.
+
+How not to fingerprint
+----------------------
+
+Prior to fixing #18733 we used the following (flawed) scheme to fingerprint a
+group in hash environment `hash_env0`:
+
+ 1. extend hash_env0, giving each declaration in the group the fingerprint 0
+ 2. use this environment to hash the declarations' ABIs, resulting in
+ group_fingerprint
+ 3. produce the final hash environment by extending hash_env0, mapping each
+ declaration of the group to group_fingerprint
+
+However, this is wrong. Consider, for instance, a program like:
+
+ data A = ARecu B | ABase String deriving (Show)
+ data B = BRecu A | BBase Int deriving (Show)
+
+ info :: B
+ info = BBase 1
+
+A consequence of (3) is that A and B will have the same fingerprint. This means
+that if the user changes `info` to:
+
+ info :: A
+ info = ABase "hello"
+
+The program's ABI fingerprint will not change despite `info`'s type, and
+therefore ABI, being clearly different.
+
+However, the incorrectness doesn't end there: (1) means that all recursive
+occurrences of names within the group will be given the same fingerprint. This
+means that the group's fingerprint won't change if we change an occurrence of A
+to B.
+
+Surprisingly, this bug (#18733) lurked for many years before being uncovered.
+
+How we now fingerprint
+----------------------
+
+As seen above, the fingerprinting function must ensure that a groups
+fingerprint captures the structure of within-group occurrences. The scheme that
+we use is:
+
+ 0. To ensure determinism, sort the declarations into a stable order by
+ declaration name
+
+ 1. Extend hash_env0, giving each declaration in the group a sequential
+ fingerprint (e.g. 0, 1, 2, ...).
+
+ 2. Use this environment to hash the declarations' ABIs, resulting in
+ group_fingerprint.
+
+ Since we included the sequence number in step (1) programs identical up to
+ transposition of recursive occurrences are distinguisable, avoiding the
+ second issue mentioned above.
+
+ 3. Produce the final environment by extending hash_env, mapping each
+ declaration of the group to the hash of (group_fingerprint, i), where
+ i is the position of the declaration in the stable ordering.
+
+ Including i in the hash ensures that the first issue noted above is
+ avoided.
+
-}
-- | Add fingerprints for top-level declarations to a 'ModIface'.
@@ -854,18 +926,27 @@ addFingerprints hsc_env iface0
return (env', (hash,decl) : decls_w_hashes)
fingerprint_group (local_env, decls_w_hashes) (CyclicSCC abis)
- = do let decls = map abiDecl abis
+ = do let stable_abis = sortBy cmp_abiNames abis
+ stable_decls = map abiDecl stable_abis
local_env1 <- foldM extend_hash_env local_env
- (zip (repeat fingerprint0) decls)
+ (zip (map mkRecFingerprint [0..]) stable_decls)
+ -- See Note [Fingerprinting recursive groups]
let hash_fn = mk_put_name local_env1
-- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
- let stable_abis = sortBy cmp_abiNames abis
-- put the cycle in a canonical order
hash <- computeFingerprint hash_fn stable_abis
- let pairs = zip (repeat hash) decls
+ let pairs = zip (map (bumpFingerprint hash) [0..]) stable_decls
+ -- See Note [Fingerprinting recursive groups]
local_env2 <- foldM extend_hash_env local_env pairs
return (local_env2, pairs ++ decls_w_hashes)
+ -- Make a fingerprint from the ordinal position of a binding in its group.
+ mkRecFingerprint :: Word64 -> Fingerprint
+ mkRecFingerprint i = Fingerprint 0 i
+
+ bumpFingerprint :: Fingerprint -> Word64 -> Fingerprint
+ bumpFingerprint fp n = fingerprintFingerprints [ fp, mkRecFingerprint n ]
+
-- we have fingerprinted the whole declaration, but we now need
-- to assign fingerprints to all the OccNames that it binds, to
-- use when referencing those OccNames in later declarations.
@@ -884,7 +965,8 @@ addFingerprints hsc_env iface0
-- when calculating fingerprints, we always need to use canonical
-- ordering for lists of things. In particular, the mi_deps has various
-- lists of modules and suchlike, so put these all in canonical order:
- let sorted_deps = sortDependencies (mi_deps iface0)
+ let sorted_deps :: Dependencies
+ sorted_deps = sortDependencies (mi_deps iface0)
-- The export hash of a module depends on the orphan hashes of the
-- orphan modules below us in the dependency tree. This is the way
@@ -971,7 +1053,8 @@ addFingerprints hsc_env iface0
--
-- put the declarations in a canonical order, sorted by OccName
- let sorted_decls = Map.elems $ Map.fromList $
+ let sorted_decls :: [(Fingerprint, IfaceDecl)]
+ sorted_decls = Map.elems $ Map.fromList $
[(getOccName d, e) | e@(_, d) <- decls_w_hashes]
-- the flag hash depends on:
=====================================
testsuite/tests/driver/T18733/Library1.hs
=====================================
@@ -0,0 +1,7 @@
+module Library where
+
+data A = ARecu B | ABase String deriving (Show)
+data B = BRecu A | BBase Int deriving (Show)
+
+info :: B
+info = BBase 1
=====================================
testsuite/tests/driver/T18733/Library2.hs
=====================================
@@ -0,0 +1,7 @@
+module Library where
+
+data A = ARecu B | ABase String deriving (Show)
+data B = BRecu A | BBase Int deriving (Show)
+
+info :: A
+info = ABase "Hello"
=====================================
testsuite/tests/driver/T18733/Main.hs
=====================================
@@ -0,0 +1,5 @@
+module Main where
+
+import Library
+
+main = putStrLn $ show info
=====================================
testsuite/tests/driver/T18733/Makefile
=====================================
@@ -0,0 +1,12 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T18733:
+ cp Library1.hs Library.hs
+ '$(TEST_HC)' -v0 -o Main Library.hs Main.hs
+ ./Main
+
+ cp Library2.hs Library.hs
+ '$(TEST_HC)' -v0 -o Main Library.hs Main.hs
+ ./Main
=====================================
testsuite/tests/driver/T18733/T18733.stdout
=====================================
@@ -0,0 +1,2 @@
+BBase 1
+ABase "Hello"
=====================================
testsuite/tests/driver/T18733/all.T
=====================================
@@ -0,0 +1,2 @@
+srcs = ['Library1.hs', 'Library2.hs', 'Main.hs']
+test('T18733', extra_files(srcs), makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5506f1342e51bad71a7525ddad0650d1ac63afeb...5353fd500b1e92636cd9d45274585fd88a915ff6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/5506f1342e51bad71a7525ddad0650d1ac63afeb...5353fd500b1e92636cd9d45274585fd88a915ff6
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20201113/8f1c3e11/attachment-0001.html>
More information about the ghc-commits
mailing list