From 694ec5b1d3d1f67ba5b14b84e054b0716dc5cb6d Mon Sep 17 00:00:00 2001
From: sheaf <sam.derbyshire@gmail.com>
Date: Wed, 23 Aug 2023 13:27:49 +0200
Subject: [PATCH] Don't bundle children for non-parent Avails
We used to bundle all children of the parent Avail with things that
aren't the parent, e.g. with
class C a where
type T a
meth :: ..
we would bundle the whole Avail (C, T, meth) with all of C, T and meth,
instead of only with C.
Avoiding this fixes #23570
---
compiler/GHC/Rename/Names.hs | 28 +++++++++++++------
testsuite/tests/rename/should_fail/T23570.hs | 6 ++++
.../tests/rename/should_fail/T23570.stderr | 6 ++++
.../tests/rename/should_fail/T23570_aux.hs | 7 +++++
testsuite/tests/rename/should_fail/T23570b.hs | 5 ++++
.../tests/rename/should_fail/T23570b.stderr | 5 ++++
testsuite/tests/rename/should_fail/all.T | 2 ++
7 files changed, 50 insertions(+), 9 deletions(-)
create mode 100644 testsuite/tests/rename/should_fail/T23570.hs
create mode 100644 testsuite/tests/rename/should_fail/T23570.stderr
create mode 100644 testsuite/tests/rename/should_fail/T23570_aux.hs
create mode 100644 testsuite/tests/rename/should_fail/T23570b.hs
create mode 100644 testsuite/tests/rename/should_fail/T23570b.stderr
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 0bdb14f30766..18fab379095a 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1303,8 +1303,13 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
, export_depr_warns )
IEThingAll _ (L l tc) -> do
- ImpOccItem gre child_gres _ <- lookup_parent ie $ ieWrappedName tc
+ ImpOccItem { imp_item = gre
+ , imp_bundled = bundled_gres
+ , imp_is_parent = is_par
+ }
+ <- lookup_parent ie $ ieWrappedName tc
let name = greName gre
+ child_gres = if is_par then bundled_gres else []
imp_list_warn
| null child_gres
@@ -1445,18 +1450,23 @@ data ImpOccItem
mkImportOccEnv :: HscEnv -> ImpDeclSpec -> [IfaceExport] -> OccEnv (NameEnv ImpOccItem)
mkImportOccEnv hsc_env decl_spec all_avails =
mkOccEnv_C (plusNameEnv_C combine)
- [ (occ, mkNameEnv [(nm, ImpOccItem g bundled is_parent)])
+ [ (occ, mkNameEnv [(nm, item)])
| avail <- all_avails
- , let gs = gresFromAvail hsc_env (Just hiding_spec) avail
- , g <- gs
- , let nm = greName g
- occ = greOccName g
+ , let gres = gresFromAvail hsc_env (Just hiding_spec) avail
+ , gre <- gres
+ , let nm = greName gre
+ occ = greOccName gre
(is_parent, bundled) = case avail of
AvailTC c _
- -> if c == nm -- (Recall the AvailTC invariant)
- then ( True, case gs of { g0 : gs' | greName g0 == nm -> gs'; _ -> gs } )
- else ( False, gs )
+ | c == nm -- (Recall the AvailTC invariant from GHC.Types.AvailInfo)
+ -> ( True, drop 1 gres ) -- "drop 1": don't include the parent itself.
+ | otherwise
+ -> ( False, gres )
_ -> ( False, [] )
+ item = ImpOccItem
+ { imp_item = gre
+ , imp_bundled = bundled
+ , imp_is_parent = is_parent }
]
where
diff --git a/testsuite/tests/rename/should_fail/T23570.hs b/testsuite/tests/rename/should_fail/T23570.hs
new file mode 100644
index 000000000000..1b8680e264a4
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T23570.hs
@@ -0,0 +1,6 @@
+module T23570 where
+
+import T23570_aux (T(..))
+
+f :: C a => a -> T a ()
+f = meth
diff --git a/testsuite/tests/rename/should_fail/T23570.stderr b/testsuite/tests/rename/should_fail/T23570.stderr
new file mode 100644
index 000000000000..00f938292072
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T23570.stderr
@@ -0,0 +1,6 @@
+
+T23570.hs:5:6: error: [GHC-76037]
+ Not in scope: type constructor or class ‘C’
+ Suggested fix:
+ Add ‘C’ to the import list in the import of ‘T23570_aux’
+ (at T23570.hs:3:1-25).
diff --git a/testsuite/tests/rename/should_fail/T23570_aux.hs b/testsuite/tests/rename/should_fail/T23570_aux.hs
new file mode 100644
index 000000000000..fda0a4a45295
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T23570_aux.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+
+module T23570_aux where
+
+class C a where
+ type T a
+ meth :: a -> T a
diff --git a/testsuite/tests/rename/should_fail/T23570b.hs b/testsuite/tests/rename/should_fail/T23570b.hs
new file mode 100644
index 000000000000..bc605cd177c2
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T23570b.hs
@@ -0,0 +1,5 @@
+{-# OPTIONS_GHC -Wdodgy-imports #-}
+
+module T23570b where
+
+import T23570_aux (T(..))
diff --git a/testsuite/tests/rename/should_fail/T23570b.stderr b/testsuite/tests/rename/should_fail/T23570b.stderr
new file mode 100644
index 000000000000..186f8ab399a9
--- /dev/null
+++ b/testsuite/tests/rename/should_fail/T23570b.stderr
@@ -0,0 +1,5 @@
+
+T23570b.hs:5:20: warning: [GHC-99623] [-Wdodgy-imports (in -Wextra)]
+ The import item ‘T23570_aux.T(..)’ suggests that
+ ‘T23570_aux.T’ has (in-scope) constructors or record fields,
+ but it has none
diff --git a/testsuite/tests/rename/should_fail/all.T b/testsuite/tests/rename/should_fail/all.T
index 20cc26b9b72b..2c68cfb484f4 100644
--- a/testsuite/tests/rename/should_fail/all.T
+++ b/testsuite/tests/rename/should_fail/all.T
@@ -210,3 +210,5 @@ test('T22478b', normal, compile_fail, [''])
test('T22478d', normal, compile_fail, [''])
test('T22478e', normal, compile_fail, [''])
test('T22478f', normal, compile_fail, [''])
+test('T23570', [extra_files(['T23570_aux.hs'])], multimod_compile_fail, ['T23570', '-v0'])
+test('T23570b', [extra_files(['T23570_aux.hs'])], multimod_compile, ['T23570b', '-v0'])
\ No newline at end of file
--
GitLab