[commit: ghc] master: Remove duplicates in -ddump-minimial-imports (84cba4b)
git at git.haskell.org
git at git.haskell.org
Wed Dec 5 10:34:12 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/84cba4bce65ffc99e2356b3621cf91258b055cad/ghc
>---------------------------------------------------------------
commit 84cba4bce65ffc99e2356b3621cf91258b055cad
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed Dec 5 10:12:09 2018 +0000
Remove duplicates in -ddump-minimial-imports
This fixes Trac #15994.
Previously RdrName.gresToAvailInfo assumed that the input list
of GREs had no duplicates. I accidentally broke this precondition
in this refactoring:
commit 6353efc7694ba8ec86c091918e02595662169ae2
Date: Thu Nov 22 14:48:05 2018 -0500
Fix unused-import warnings
This patch fixes a fairly long-standing bug (dating back to 2015) in
RdrName.bestImport, namely
(There was an ASSERT, but it's usually switched off in stage2. It
tripped when I switched stage2 assertions on.)
The fix is straightforward: account for dups in gresToAvailInfo.
>---------------------------------------------------------------
84cba4bce65ffc99e2356b3621cf91258b055cad
compiler/basicTypes/RdrName.hs | 42 +++++++++++++---------
testsuite/tests/rename/should_compile/Makefile | 7 +++-
testsuite/tests/rename/should_compile/T15994.hs | 5 +++
.../tests/rename/should_compile/T15994.stdout | 1 +
testsuite/tests/rename/should_compile/all.T | 1 +
5 files changed, 38 insertions(+), 18 deletions(-)
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs
index 6a3db51..60e4e84 100644
--- a/compiler/basicTypes/RdrName.hs
+++ b/compiler/basicTypes/RdrName.hs
@@ -88,7 +88,7 @@ import Util
import NameEnv
import Data.Data
-import Data.List( sortBy, nub )
+import Data.List( sortBy )
{-
************************************************************************
@@ -696,17 +696,26 @@ greParent_maybe gre = case gre_par gre of
-- uniqueness assumption.
gresToAvailInfo :: [GlobalRdrElt] -> [AvailInfo]
gresToAvailInfo gres
- = ASSERT( nub gres == gres ) nameEnvElts avail_env
+ = nameEnvElts avail_env
where
- avail_env :: NameEnv AvailInfo -- keyed by the parent
- avail_env = foldl' add emptyNameEnv gres
-
- add :: NameEnv AvailInfo -> GlobalRdrElt -> NameEnv AvailInfo
- add env gre = extendNameEnv_Acc comb availFromGRE env
- (fromMaybe (gre_name gre)
- (greParent_maybe gre)) gre
-
+ avail_env :: NameEnv AvailInfo -- Keyed by the parent
+ (avail_env, _) = foldl' add (emptyNameEnv, emptyNameSet) gres
+
+ add :: (NameEnv AvailInfo, NameSet)
+ -> GlobalRdrElt
+ -> (NameEnv AvailInfo, NameSet)
+ add (env, done) gre
+ | name `elemNameSet` done
+ = (env, done) -- Don't insert twice into the AvailInfo
+ | otherwise
+ = ( extendNameEnv_Acc comb availFromGRE env key gre
+ , done `extendNameSet` name )
where
+ name = gre_name gre
+ key = case greParent_maybe gre of
+ Just parent -> parent
+ Nothing -> gre_name gre
+
-- We want to insert the child `k` into a list of children but
-- need to maintain the invariant that the parent is first.
--
@@ -718,13 +727,12 @@ gresToAvailInfo gres
| otherwise = n:k:ns
comb :: GlobalRdrElt -> AvailInfo -> AvailInfo
- comb _ (Avail n) = Avail n -- Duplicated name
- comb gre (AvailTC m ns fls) =
- let n = gre_name gre
- in case gre_par gre of
- NoParent -> AvailTC m (n:ns) fls -- Not sure this ever happens
- ParentIs {} -> AvailTC m (insertChildIntoChildren m ns n) fls
- FldParent _ mb_lbl -> AvailTC m ns (mkFieldLabel n mb_lbl : fls)
+ comb _ (Avail n) = Avail n -- Duplicated name, should not happen
+ comb gre (AvailTC m ns fls)
+ = case gre_par gre of
+ NoParent -> AvailTC m (name:ns) fls -- Not sure this ever happens
+ ParentIs {} -> AvailTC m (insertChildIntoChildren m ns name) fls
+ FldParent _ mb_lbl -> AvailTC m ns (mkFieldLabel name mb_lbl : fls)
availFromGRE :: GlobalRdrElt -> AvailInfo
availFromGRE (GRE { gre_name = me, gre_par = parent })
diff --git a/testsuite/tests/rename/should_compile/Makefile b/testsuite/tests/rename/should_compile/Makefile
index 69e899b..6e41534 100644
--- a/testsuite/tests/rename/should_compile/Makefile
+++ b/testsuite/tests/rename/should_compile/Makefile
@@ -27,12 +27,17 @@ T3449:
'$(TEST_HC)' $(TEST_HC_OPTS) -Wall -c T3449.hs
T4239:
- $(RM) T4239A.hi T4239A.o
+ $(RM) TT4239A.hi T4239A.o
$(RM) T4239.hi T4239.o T4239.imports
'$(TEST_HC)' $(TEST_HC_OPTS) -c T4239A.hs
'$(TEST_HC)' $(TEST_HC_OPTS) -c T4239.hs -ddump-minimal-imports
cat T4239.imports
+T15994:
+ $(RM) T15994.hi T15994.o T15994.imports
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c T15994.hs -ddump-minimal-imports
+ cat T15994.imports
+
T4240:
$(RM) T4240A.hi T4240A.o
$(RM) T4240B.hi T4240B.o
diff --git a/testsuite/tests/rename/should_compile/T15994.hs b/testsuite/tests/rename/should_compile/T15994.hs
new file mode 100644
index 0000000..ff7c56f
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T15994.hs
@@ -0,0 +1,5 @@
+module T15994 where
+
+import System.IO
+
+f = [ReadMode, ReadMode]
diff --git a/testsuite/tests/rename/should_compile/T15994.stdout b/testsuite/tests/rename/should_compile/T15994.stdout
new file mode 100644
index 0000000..3297349
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T15994.stdout
@@ -0,0 +1 @@
+import System.IO ( IOMode(ReadMode) )
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 86f04d0..b6c06c1 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -162,3 +162,4 @@ test('T14487', [], multimod_compile, ['T14487', '-v0'])
test('T14747', [], multimod_compile, ['T14747', '-v0'])
test('T15149', [], multimod_compile, ['T15149', '-v0'])
test('T13064', normal, compile, [''])
+test('T15994', [], run_command, ['$MAKE -s --no-print-directory T15994'])
More information about the ghc-commits
mailing list