From 59d7ee53906b9cee7f279c1f9567af7b930f8636 Mon Sep 17 00:00:00 2001
From: mniip <mniip@mniip.com>
Date: Sat, 1 Oct 2016 00:26:04 -0400
Subject: [PATCH] GHCi: Don't remove shadowed bindings from typechecker scope.
The shadowed out bindings are accessible via qualified names like
Ghci1.foo. Since they are accessable in the renamer the typechecker
should be able to see them too. As a consequence they show up in :show
bindings.
This fixes T11547
Test Plan:
Fixed current tests to accomodate to new stuff in :show bindings
Added a test that verifies that the typechecker doesn't crash
Reviewers: austin, bgamari, simonpj
Reviewed By: simonpj
Subscribers: simonpj, thomie
Differential Revision: https://phabricator.haskell.org/D2447
GHC Trac Issues: #11547
---
compiler/main/HscTypes.hs | 13 ++-----------
.../tests/ghci.debugger/scripts/break011.stdout | 7 +++++++
.../tests/ghci.debugger/scripts/hist001.stdout | 4 ++++
testsuite/tests/ghci/scripts/T11547.script | 9 +++++++++
testsuite/tests/ghci/scripts/T11547.stdout | 5 +++++
testsuite/tests/ghci/scripts/T2976.stdout | 2 ++
testsuite/tests/ghci/scripts/all.T | 1 +
7 files changed, 30 insertions(+), 11 deletions(-)
create mode 100644 testsuite/tests/ghci/scripts/T11547.script
create mode 100644 testsuite/tests/ghci/scripts/T11547.stdout
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index ddeee33ebe78..127775e82289 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -1522,7 +1522,7 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
= ictxt { ic_mod_index = ic_mod_index ictxt + 1
-- Always bump this; even instances should create
-- a new mod_index (Trac #9426)
- , ic_tythings = new_tythings ++ old_tythings
+ , ic_tythings = new_tythings ++ ic_tythings ictxt
, ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings
, ic_instances = ( new_cls_insts ++ old_cls_insts
, new_fam_insts ++ old_fam_insts )
@@ -1530,8 +1530,6 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
, ic_fix_env = fix_env -- See Note [Fixity declarations in GHCi]
}
where
- new_ids = [id | AnId id <- new_tythings]
- old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
-- Discard old instances that have been fully overrridden
-- See Note [Override identical instances in GHCi]
@@ -1544,17 +1542,10 @@ extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveCont
extendInteractiveContextWithIds ictxt new_ids
| null new_ids = ictxt
| otherwise = ictxt { ic_mod_index = ic_mod_index ictxt + 1
- , ic_tythings = new_tythings ++ old_tythings
+ , ic_tythings = new_tythings ++ ic_tythings ictxt
, ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings }
where
new_tythings = map AnId new_ids
- old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
-
-shadowed_by :: [Id] -> TyThing -> Bool
-shadowed_by ids = shadowed
- where
- shadowed id = getOccName id `elemOccSet` new_occs
- new_occs = mkOccSet (map getOccName ids)
setInteractivePackage :: HscEnv -> HscEnv
-- Set the 'thisPackage' DynFlag to 'interactive'
diff --git a/testsuite/tests/ghci.debugger/scripts/break011.stdout b/testsuite/tests/ghci.debugger/scripts/break011.stdout
index 47fb7b135de1..ac5b7e3a2413 100644
--- a/testsuite/tests/ghci.debugger/scripts/break011.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/break011.stdout
@@ -23,6 +23,13 @@ _exception = SomeException
"foo"
"CallStack (from HasCallStack):
error, called at Test7.hs:2:18 in main:Main")
+Ghci1._exception :: SomeException = SomeException
+ (ErrorCallWithLocation
+ "foo"
+ "CallStack (from HasCallStack):
+ error, called at Test7.hs:<line>:<column> in <package-id>:Main")
+Ghci2._result :: a = _
+Ghci3._result :: IO a = _
_result :: a = _
_exception :: SomeException = SomeException
(ErrorCallWithLocation
diff --git a/testsuite/tests/ghci.debugger/scripts/hist001.stdout b/testsuite/tests/ghci.debugger/scripts/hist001.stdout
index a19a34f315f7..523605b00a6f 100644
--- a/testsuite/tests/ghci.debugger/scripts/hist001.stdout
+++ b/testsuite/tests/ghci.debugger/scripts/hist001.stdout
@@ -12,6 +12,7 @@ Logged breakpoint at Test3.hs:2:22-31
_result :: [a]
f :: t -> a
xs :: [t]
+Ghci1._result :: [a] = _
xs :: [t] = []
f :: t -> a = _
_result :: [a] = _
@@ -19,7 +20,10 @@ Logged breakpoint at Test3.hs:2:18-20
_result :: a
f :: Integer -> a
x :: Integer
+Ghci1._result :: [a] = _
xs :: [t] = []
+Ghci2.f :: t -> a = _
+Ghci2._result :: [a] = _
x :: Integer = 2
f :: Integer -> a = _
_result :: a = _
diff --git a/testsuite/tests/ghci/scripts/T11547.script b/testsuite/tests/ghci/scripts/T11547.script
new file mode 100644
index 000000000000..c4c15d6f78d9
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T11547.script
@@ -0,0 +1,9 @@
+foo = foo
+:t Ghci1.foo
+foo = foo
+:t Ghci2.foo
+:t Ghci1.foo
+data Foo = Foo | Bar
+data Foo = Bar
+:t Foo
+:t Ghci3.Bar
diff --git a/testsuite/tests/ghci/scripts/T11547.stdout b/testsuite/tests/ghci/scripts/T11547.stdout
new file mode 100644
index 000000000000..6f2a8333c3ab
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T11547.stdout
@@ -0,0 +1,5 @@
+Ghci1.foo :: t
+Ghci2.foo :: t
+Ghci1.foo :: t
+Foo :: Ghci3.Foo
+Ghci3.Bar :: Ghci3.Foo
diff --git a/testsuite/tests/ghci/scripts/T2976.stdout b/testsuite/tests/ghci/scripts/T2976.stdout
index 9fdc11072c25..de31112bb334 100644
--- a/testsuite/tests/ghci/scripts/T2976.stdout
+++ b/testsuite/tests/ghci/scripts/T2976.stdout
@@ -1,6 +1,8 @@
test :: Integer = 0
test = 0
test :: Integer = 0
+Ghci1.test :: Integer = 0
test :: [Char] = _
test = "test"
+Ghci1.test :: Integer = 0
test :: [Char] = "test"
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 9e3656728df1..20888ae1db31 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -258,6 +258,7 @@ test('T11376', normal, ghci_script, ['T11376.script'])
test('T12007', normal, ghci_script, ['T12007.script'])
test('T11975', normal, ghci_script, ['T11975.script'])
test('T10963', normal, ghci_script, ['T10963.script'])
+test('T11547', normal, ghci_script, ['T11547.script'])
test('T12520', normal, ghci_script, ['T12520.script'])
test('T12091',
[expect_broken(12091), extra_run_opts('-fobject-code')],
--
GitLab