Remove duplicates in -ddump-minimial-imports
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 5 Dec 2018 10:12:09 +0000 (10:12 +0000)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 5 Dec 2018 10:15:40 +0000 (10:15 +0000)
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.

compiler/basicTypes/RdrName.hs
testsuite/tests/rename/should_compile/Makefile
testsuite/tests/rename/should_compile/T15994.hs [new file with mode: 0644]
testsuite/tests/rename/should_compile/T15994.stdout [new file with mode: 0644]
testsuite/tests/rename/should_compile/all.T

index 6a3db51..60e4e84 100644 (file)
@@ -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 })
index 69e899b..6e41534 100644 (file)
@@ -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 (file)
index 0000000..ff7c56f
--- /dev/null
@@ -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 (file)
index 0000000..3297349
--- /dev/null
@@ -0,0 +1 @@
+import System.IO ( IOMode(ReadMode) )
index 86f04d0..b6c06c1 100644 (file)
@@ -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'])