Compute export hash based on ALL transitive orphan modules.
authorEdward Z. Yang <ezyang@cs.stanford.edu>
Wed, 19 Oct 2016 02:17:10 +0000 (22:17 -0400)
committerBen Gamari <ben@smart-cactus.org>
Wed, 19 Oct 2016 02:17:10 +0000 (22:17 -0400)
Previously we pruned out orphan modules from external packages but this
was wrong.  Fixes #12733 (which has more discussion.)

Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Test Plan: validate

Reviewers: simonpj, bgamari, austin

Reviewed By: simonpj

Subscribers: simonpj, thomie

Differential Revision: https://phabricator.haskell.org/D2610

GHC Trac Issues: #12733

15 files changed:
compiler/iface/MkIface.hs
testsuite/driver/extra_files.py
testsuite/tests/cabal/T12733/.gitignore [new file with mode: 0644]
testsuite/tests/cabal/T12733/Makefile [new file with mode: 0644]
testsuite/tests/cabal/T12733/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/T12733/T12733.stderr [new file with mode: 0644]
testsuite/tests/cabal/T12733/all.T [new file with mode: 0644]
testsuite/tests/cabal/T12733/p/P.hs.in1 [new file with mode: 0644]
testsuite/tests/cabal/T12733/p/P.hs.in2 [new file with mode: 0644]
testsuite/tests/cabal/T12733/p/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/T12733/p/p.cabal [new file with mode: 0644]
testsuite/tests/cabal/T12733/q/Q.hs [new file with mode: 0644]
testsuite/tests/cabal/T12733/q/Q2.hs [new file with mode: 0644]
testsuite/tests/cabal/T12733/q/Setup.hs [new file with mode: 0644]
testsuite/tests/cabal/T12733/q/q.cabal [new file with mode: 0644]

index 219d905..25e75ef 100644 (file)
@@ -561,16 +561,33 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    -- lists of modules and suchlike, so put these all in canonical order:
    let sorted_deps = sortDependencies (mi_deps iface0)
 
-   -- the export hash of a module depends on the orphan hashes of the
+   -- 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
    -- that changes in orphans get propagated all the way up the
-   -- dependency tree.  We only care about orphan modules in the current
-   -- package, because changes to orphans outside this package will be
-   -- tracked by the usage on the ABI hash of package modules that we import.
+   -- dependency tree.
+   --
+   -- Note [A bad dep_orphs optimization]
+   -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   -- In a previous version of this code, we filtered out orphan modules which
+   -- were not from the home package, justifying it by saying that "we'd
+   -- pick up the ABI hashes of the external module instead".  This is wrong.
+   -- Suppose that we have:
+   --
+   --       module External where
+   --           instance Show (a -> b)
+   --
+   --       module Home1 where
+   --           import External
+   --
+   --       module Home2 where
+   --           import Home1
+   --
+   -- The export hash of Home1 needs to reflect the orphan instances of
+   -- External. It's true that Home1 will get rebuilt if the orphans
+   -- of External, but we also need to make sure Home2 gets rebuilt
+   -- as well.  See #12733 for more details.
    let orph_mods
         = filter (/= this_mod) -- Note [Do not update EPS with your own hi-boot]
-        -- TODO: the line below is not correct, see #12733
-        . filter ((== this_pkg) . moduleUnitId)
         $ dep_orphs sorted_deps
    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
 
@@ -688,7 +705,6 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
     this_mod = mi_module iface0
     semantic_mod = mi_semantic_module iface0
     dflags = hsc_dflags hsc_env
-    this_pkg = thisPackage dflags
     (non_orph_insts, orph_insts) = mkOrphMap ifInstOrph    (mi_insts iface0)
     (non_orph_rules, orph_rules) = mkOrphMap ifRuleOrph    (mi_rules iface0)
     (non_orph_fis,   orph_fis)   = mkOrphMap ifFamInstOrph (mi_fam_insts iface0)
@@ -734,10 +750,14 @@ getOrphanHashes hsc_env mods = do
     dflags     = hsc_dflags hsc_env
     get_orph_hash mod =
           case lookupIfaceByModule dflags hpt pit mod of
-            Nothing    -> pprPanic "moduleOrphanHash" (ppr mod)
-            Just iface -> mi_orphan_hash iface
+            Just iface -> return (mi_orphan_hash iface)
+            Nothing    -> do -- similar to 'mkHashFun'
+                iface <- initIfaceLoad hsc_env . withException
+                            $ loadInterface (text "getOrphanHashes") mod ImportBySystem
+                return (mi_orphan_hash iface)
+
   --
-  return (map get_orph_hash mods)
+  mapM get_orph_hash mods
 
 
 sortDependencies :: Dependencies -> Dependencies
index c360537..eb0aa27 100644 (file)
@@ -86,6 +86,7 @@ extra_src_files = {
   'T12062': ['A.hs', 'A.hs-boot', 'C.hs'],
   'T12035j': ['T12035.hs', 'T12035a.hs', 'T12035.hs-boot'],
   'T12485': ['a.pkg', 'b.pkg', 'Main.hs'],
+  'T12733': ['p/', 'q/', 'Setup.hs'],
   'T1372': ['p1/', 'p2/'],
   'T1407': ['A.c'],
   'T1959': ['B.hs', 'C.hs', 'D.hs', 'E1.hs', 'E2.hs'],
diff --git a/testsuite/tests/cabal/T12733/.gitignore b/testsuite/tests/cabal/T12733/.gitignore
new file mode 100644 (file)
index 0000000..b5b727a
--- /dev/null
@@ -0,0 +1 @@
+p/P.hs
diff --git a/testsuite/tests/cabal/T12733/Makefile b/testsuite/tests/cabal/T12733/Makefile
new file mode 100644 (file)
index 0000000..04de2ad
--- /dev/null
@@ -0,0 +1,31 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+SETUP=../Setup -v0
+
+T12733: clean
+       $(MAKE) -s --no-print-directory clean
+       '$(GHC_PKG)' init tmp.d
+       '$(TEST_HC)' -v0 --make Setup
+       cp p/P.hs.in1 p/P.hs
+       cd p && $(SETUP) clean
+       cd p && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d
+       cd p && $(SETUP) build
+       cd p && $(SETUP) register --inplace
+       cd q && $(SETUP) clean
+       cd q && $(SETUP) configure $(CABAL_MINIMAL_BUILD) --with-ghc='$(TEST_HC)' --ghc-options='$(TEST_HC_OPTS)' --package-db=../tmp.d
+       cd q && $(SETUP) build
+       cd q && $(SETUP) register --inplace
+       # Building q should have taken enough time
+       cp p/P.hs.in2 p/P.hs
+       cd p && $(SETUP) build
+       # should fail due to overlapping instance
+       cd q && ! $(SETUP) build
+
+ifneq "$(CLEANUP)" ""
+       $(MAKE) -s --no-print-directory clean
+endif
+
+clean :
+       $(RM) -r tmp*.d inst-* *.o *.hi */*.o */*.hi */Setup$(exeext) */dist Setup$(exeext)
diff --git a/testsuite/tests/cabal/T12733/Setup.hs b/testsuite/tests/cabal/T12733/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/T12733/T12733.stderr b/testsuite/tests/cabal/T12733/T12733.stderr
new file mode 100644 (file)
index 0000000..bc4156d
--- /dev/null
@@ -0,0 +1,5 @@
+
+Q2.hs:3:10: error:
+    Duplicate instance declarations:
+      instance Show (IO a) -- Defined at Q2.hs:3:10
+      instance [safe] Show (IO a) -- Defined in ā€˜Pā€™
diff --git a/testsuite/tests/cabal/T12733/all.T b/testsuite/tests/cabal/T12733/all.T
new file mode 100644 (file)
index 0000000..8b00daa
--- /dev/null
@@ -0,0 +1,9 @@
+if config.cleanup:
+   cleanup = 'CLEANUP=1'
+else:
+   cleanup = 'CLEANUP=0'
+
+test('T12733',
+     normal,
+     run_command,
+     ['$MAKE -s --no-print-directory T12733 ' + cleanup])
diff --git a/testsuite/tests/cabal/T12733/p/P.hs.in1 b/testsuite/tests/cabal/T12733/p/P.hs.in1
new file mode 100644 (file)
index 0000000..41aaf80
--- /dev/null
@@ -0,0 +1,3 @@
+module P where
+instance Show (a -> b) where
+    show = undefined
diff --git a/testsuite/tests/cabal/T12733/p/P.hs.in2 b/testsuite/tests/cabal/T12733/p/P.hs.in2
new file mode 100644 (file)
index 0000000..4a80619
--- /dev/null
@@ -0,0 +1,5 @@
+module P where
+instance Show (a -> b) where
+    show = undefined
+instance Show (IO a) where
+    show = undefined
diff --git a/testsuite/tests/cabal/T12733/p/Setup.hs b/testsuite/tests/cabal/T12733/p/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/T12733/p/p.cabal b/testsuite/tests/cabal/T12733/p/p.cabal
new file mode 100644 (file)
index 0000000..b0113ee
--- /dev/null
@@ -0,0 +1,11 @@
+name:                p
+version:             0.1.0.0
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     P
+  build-depends:       base
+  default-language:    Haskell2010
diff --git a/testsuite/tests/cabal/T12733/q/Q.hs b/testsuite/tests/cabal/T12733/q/Q.hs
new file mode 100644 (file)
index 0000000..8c7bcdc
--- /dev/null
@@ -0,0 +1,2 @@
+module Q where
+import P
diff --git a/testsuite/tests/cabal/T12733/q/Q2.hs b/testsuite/tests/cabal/T12733/q/Q2.hs
new file mode 100644 (file)
index 0000000..c85e9ba
--- /dev/null
@@ -0,0 +1,4 @@
+module Q2 where
+import Q
+instance Show (IO a) where
+    show = undefined
diff --git a/testsuite/tests/cabal/T12733/q/Setup.hs b/testsuite/tests/cabal/T12733/q/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/testsuite/tests/cabal/T12733/q/q.cabal b/testsuite/tests/cabal/T12733/q/q.cabal
new file mode 100644 (file)
index 0000000..81591a1
--- /dev/null
@@ -0,0 +1,11 @@
+name:                q
+version:             0.1.0.0
+author:              Edward Z. Yang
+maintainer:          ezyang@cs.stanford.edu
+build-type:          Simple
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     Q Q2
+  build-depends:       base, p
+  default-language:    Haskell2010