summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAdam Gundry <adam@well-typed.com>2021-02-05 22:19:59 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-10 10:33:36 -0500
commitd095954bc9dfcee9f3094bc4994b3a69df8f409d (patch)
tree02441eadf289f20d7a29fcbafea99f37b4e60e53
parentafc357d269b6e1d56385220e78fe696c161e9bf7 (diff)
downloadhaskell-d095954bc9dfcee9f3094bc4994b3a69df8f409d.tar.gz
Do not remove shadowed record selectors from interactive context (fixes #19322)
-rw-r--r--compiler/GHC/Runtime/Context.hs5
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/T19322.script5
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/T19322.stdout1
-rw-r--r--testsuite/tests/overloadedrecflds/ghci/all.T1
4 files changed, 11 insertions, 1 deletions
diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs
index a69e358e32..243624553d 100644
--- a/compiler/GHC/Runtime/Context.hs
+++ b/compiler/GHC/Runtime/Context.hs
@@ -31,6 +31,7 @@ import GHC.Core.Type
import GHC.Types.Avail
import GHC.Types.Fixity.Env
+import GHC.Types.Id ( isRecordSelector )
import GHC.Types.Id.Info ( IdDetails(..) )
import GHC.Types.Name
import GHC.Types.Name.Env
@@ -342,7 +343,9 @@ extendInteractiveContextWithIds ictxt new_ids
shadowed_by :: [Id] -> TyThing -> Bool
shadowed_by ids = shadowed
where
- shadowed id = getOccName id `elemOccSet` new_occs
+ -- Keep record selectors because they might be needed by HasField (#19322)
+ shadowed (AnId id) | isRecordSelector id = False
+ shadowed tything = getOccName tything `elemOccSet` new_occs
new_occs = mkOccSet (map getOccName ids)
setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
diff --git a/testsuite/tests/overloadedrecflds/ghci/T19322.script b/testsuite/tests/overloadedrecflds/ghci/T19322.script
new file mode 100644
index 0000000000..5a9e2c3407
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/T19322.script
@@ -0,0 +1,5 @@
+:set -XTypeApplications -XDataKinds
+import GHC.Records
+data X = X { name :: String }
+data Y = Y { name :: String }
+getField @"name" $ X "Tom"
diff --git a/testsuite/tests/overloadedrecflds/ghci/T19322.stdout b/testsuite/tests/overloadedrecflds/ghci/T19322.stdout
new file mode 100644
index 0000000000..11988ec731
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/ghci/T19322.stdout
@@ -0,0 +1 @@
+"Tom"
diff --git a/testsuite/tests/overloadedrecflds/ghci/all.T b/testsuite/tests/overloadedrecflds/ghci/all.T
index 7bddafd6fb..f0d2544c0e 100644
--- a/testsuite/tests/overloadedrecflds/ghci/all.T
+++ b/testsuite/tests/overloadedrecflds/ghci/all.T
@@ -2,3 +2,4 @@ test('duplicaterecfldsghci01', combined_output, ghci_script, ['duplicaterecfldsg
test('overloadedlabelsghci01', combined_output, ghci_script, ['overloadedlabelsghci01.script'])
test('T13438', [expect_broken(13438), combined_output], ghci_script, ['T13438.script'])
test('GHCiDRF', [extra_files(['GHCiDRF.hs']), combined_output], ghci_script, ['GHCiDRF.script'])
+test('T19322', combined_output, ghci_script, ['T19322.script'])