Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
9f3e39d5
Commit
9f3e39d5
authored
May 02, 2014
by
Simon Peyton Jones
Browse files
Fix over-zealous unused-import warning
See Note [Un-warnable import decls] in RnNames. Fixes Trac
#9061
.
parent
f0fcc41d
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/rename/RnNames.lhs
View file @
9f3e39d5
...
...
@@ -1301,7 +1301,7 @@ type ImportDeclUsage
warnUnusedImportDecls :: TcGblEnv -> RnM ()
warnUnusedImportDecls gbl_env
= do { uses <- readMutVar (tcg_used_rdrnames gbl_env)
; let imports = filter
explicit
_import (tcg_rn_imports gbl_env)
; let imports = filter
Out un_warnable
_import (tcg_rn_imports gbl_env)
rdr_env = tcg_rdr_env gbl_env
; let usage :: [ImportDeclUsage]
...
...
@@ -1315,11 +1315,27 @@ warnUnusedImportDecls gbl_env
; whenGOptM Opt_D_dump_minimal_imports $
printMinimalImports usage }
where
explicit_import (L _ decl) = not (ideclImplicit decl)
-- Filter out the implicit Prelude import
-- which we do not want to bleat about
un_warnable_import (L _ decl) -- See Note [Un-warnable import decls]
| ideclImplicit decl
= True
| Just (True, hides) <- ideclHiding decl
, not (null hides)
, pRELUDE_NAME == unLoc (ideclName decl)
= True
| otherwise
= False
\end{code}
Note [Un-warnable import decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We do not warn about the implicit import of Prelude, since the user can't remove it
We do not warn about
import Prelude hiding( x, y )
because even if nothing else from Prelude is used, it may be essential to hide
x,y to avoid name-shadowing warnings. Example (Trac #9061)
import Prelude hiding( log )
f x = log where log = ()
Note [The ImportMap]
~~~~~~~~~~~~~~~~~~~~
...
...
testsuite/tests/module/T9061.hs
0 → 100644
View file @
9f3e39d5
{-# OPTIONS_GHC -fwarn-unused-imports #-}
module
T9061
where
import
Prelude
hiding
(
log
)
f
=
log
where
log
=
()
testsuite/tests/module/all.T
View file @
9f3e39d5
...
...
@@ -334,3 +334,4 @@ test('T414', normal, compile_fail, [''])
test
('
T414a
',
normal
,
compile
,
[''])
test
('
T414b
',
normal
,
compile
,
[''])
test
('
T3776
',
normal
,
compile
,
[''])
test
('
T9061
',
normal
,
compile
,
[''])
Administrator
@root
mentioned in commit
a35a0315
·
Dec 17, 2018
mentioned in commit
a35a0315
mentioned in commit a35a0315e3e928b4d9758c71e1a7ef8e034d16f9
Toggle commit list
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment