diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2016-05-02 00:11:30 +0200 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2016-05-02 00:12:01 +0200 |
| commit | cd85dc84b36bc5f600eb1b3805024a5b2443e1a3 (patch) | |
| tree | 1a37cca03441f0581c75a2712c72d0c658ecd40a | |
| parent | ea34f565d370404f9ea5f8bcf6a8380ffa842c49 (diff) | |
| download | haskell-cd85dc84b36bc5f600eb1b3805024a5b2443e1a3.tar.gz | |
Make sure record pattern synonym selectors are in scope in GHCi.
Beforehand, when a record pattern synonym was defined in GHCi
the selectors would not be in scope. This is because of `is_sub_bndr`
in `HscTypes.icExtendGblRdrEnv` was throwing away the selectors.
This was broken by the fix to #10520 but it is easy to resolve.
Reviewers: austin, bgamari, simonpj
Reviewed By: simonpj
Subscribers: thomie
Differential Revision: https://phabricator.haskell.org/D2147
GHC Trac Issues: #11985
| -rw-r--r-- | compiler/main/HscTypes.hs | 16 | ||||
| -rw-r--r-- | testsuite/tests/patsyn/should_run/T11985.script | 4 | ||||
| -rw-r--r-- | testsuite/tests/patsyn/should_run/T11985.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/patsyn/should_run/all.T | 1 |
4 files changed, 15 insertions, 7 deletions
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 541f0af78e..800958bd6f 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -1504,9 +1504,9 @@ icExtendGblRdrEnv env tythings | is_sub_bndr thing = env | otherwise - = foldl extendGlobalRdrEnv env1 (localGREsFromAvail avail) + = foldl extendGlobalRdrEnv env1 (concatMap localGREsFromAvail avail) where - env1 = shadowNames env (availNames avail) + env1 = shadowNames env (concatMap availNames avail) avail = tyThingAvailInfo thing -- Ugh! The new_tythings may include record selectors, since they @@ -1829,19 +1829,21 @@ tyThingsTyCoVars tts = -- | The Names that a TyThing should bring into scope. Used to build -- the GlobalRdrEnv for the InteractiveContext. -tyThingAvailInfo :: TyThing -> AvailInfo +tyThingAvailInfo :: TyThing -> [AvailInfo] tyThingAvailInfo (ATyCon t) = case tyConClass_maybe t of - Just c -> AvailTC n (n : map getName (classMethods c) + Just c -> [AvailTC n (n : map getName (classMethods c) ++ map getName (classATs c)) - [] + [] ] where n = getName c - Nothing -> AvailTC n (n : map getName dcs) flds + Nothing -> [AvailTC n (n : map getName dcs) flds] where n = getName t dcs = tyConDataCons t flds = tyConFieldLabels t +tyThingAvailInfo (AConLike (PatSynCon p)) + = map patSynAvail ((getName p) : map flSelector (patSynFieldLabels p)) tyThingAvailInfo t - = avail (getName t) + = [avail (getName t)] {- ************************************************************************ diff --git a/testsuite/tests/patsyn/should_run/T11985.script b/testsuite/tests/patsyn/should_run/T11985.script new file mode 100644 index 0000000000..efeba01e8f --- /dev/null +++ b/testsuite/tests/patsyn/should_run/T11985.script @@ -0,0 +1,4 @@ +:set -XPatternSynonyms + +pattern Point{x, y} = (x, y) +(1, 2) { x = 3} diff --git a/testsuite/tests/patsyn/should_run/T11985.stdout b/testsuite/tests/patsyn/should_run/T11985.stdout new file mode 100644 index 0000000000..3f9e8adb1b --- /dev/null +++ b/testsuite/tests/patsyn/should_run/T11985.stdout @@ -0,0 +1 @@ +(3,2) diff --git a/testsuite/tests/patsyn/should_run/all.T b/testsuite/tests/patsyn/should_run/all.T index a0bd3ce082..d98a1ff16a 100644 --- a/testsuite/tests/patsyn/should_run/all.T +++ b/testsuite/tests/patsyn/should_run/all.T @@ -12,4 +12,5 @@ test('match-unboxed', normal, compile_and_run, ['']) test('unboxed-wrapper', normal, compile_and_run, ['']) test('records-run', normal, compile_and_run, ['']) test('ghci', just_ghci, ghci_script, ['ghci.script']) +test('T11985', just_ghci, ghci_script, ['T11985.script']) test('T11224', normal, compile_and_run, ['']) |