[commit: ghc] master: Make sure record pattern synonym selectors are in scope in GHCi. (cd85dc8)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/cd85dc84b36bc5f600eb1b3805024a5b2443e1a3/ghc

>---------------------------------------------------------------

commit cd85dc84b36bc5f600eb1b3805024a5b2443e1a3
Author: Matthew Pickering <matthewtpickering at gmail.com>
Date:   Mon May 2 00:11:30 2016 +0200

    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


>---------------------------------------------------------------

cd85dc84b36bc5f600eb1b3805024a5b2443e1a3
 compiler/main/HscTypes.hs                       | 16 +++++++++-------
 testsuite/tests/patsyn/should_run/T11985.script |  4 ++++
 testsuite/tests/patsyn/should_run/T11985.stdout |  1 +
 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 541f0af..800958b 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 0000000..efeba01
--- /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 0000000..3f9e8ad
--- /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 a0bd3ce..d98a1ff 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, [''])