[commit: ghc] master: Fix #10596 by looking up 'Int' not 'Maybe Int' in the map. (00c8d4d)

[git at git.haskell.org]

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

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

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

commit 00c8d4d551472940303437be1496bf23b882273b
Author: Edward Z. Yang <ezyang at cs.stanford.edu>
Date:   Tue Jul 7 21:19:54 2015 +0200

    Fix #10596 by looking up 'Int' not 'Maybe Int' in the map.
    
    
    Test Plan: validate
    
    Reviewers: goldfire, austin, simonpj, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: simonpj, rwbarton, thomie, bgamari
    
    Differential Revision: https://phabricator.haskell.org/D1026
    
    GHC Trac Issues: #10596


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

00c8d4d551472940303437be1496bf23b882273b
 compiler/typecheck/TcSplice.hs   | 15 +++++++++++----
 testsuite/tests/th/T10596.hs     | 11 +++++++++++
 testsuite/tests/th/T10596.stderr |  1 +
 testsuite/tests/th/all.T         |  1 +
 4 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs
index a7363d8..2e368a9 100644
--- a/compiler/typecheck/TcSplice.hs
+++ b/compiler/typecheck/TcSplice.hs
@@ -6,7 +6,11 @@
 TcSplice: Template Haskell splices
 -}
 
-{-# LANGUAGE CPP, FlexibleInstances, MagicHash, ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module TcSplice(
@@ -106,7 +110,7 @@ import GHC.Desugar      ( AnnotationWrapper(..) )
 
 import qualified Data.Map as Map
 import Data.Dynamic  ( fromDynamic, toDyn )
-import Data.Typeable ( typeOf )
+import Data.Typeable ( typeOf, Typeable )
 import Data.Data (Data)
 import GHC.Exts         ( unsafeCoerce# )
 #endif
@@ -833,11 +837,14 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where
       th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
       updTcRef th_modfinalizers_var (\fins -> fin:fins)
 
+  qGetQ :: forall a. Typeable a => IOEnv (Env TcGblEnv TcLclEnv) (Maybe a)
   qGetQ = do
       th_state_var <- fmap tcg_th_state getGblEnv
       th_state <- readTcRef th_state_var
-      let x = Map.lookup (typeOf x) th_state >>= fromDynamic
-      return x
+      -- See #10596 for why we use a scoped type variable here.
+      -- ToDo: convert @undefined :: a@ to @proxy :: Proxy a@ when
+      -- we drop support for GHC 7.6.
+      return (Map.lookup (typeOf (undefined :: a)) th_state >>= fromDynamic)
 
   qPutQ x = do
       th_state_var <- fmap tcg_th_state getGblEnv
diff --git a/testsuite/tests/th/T10596.hs b/testsuite/tests/th/T10596.hs
new file mode 100644
index 0000000..c861156
--- /dev/null
+++ b/testsuite/tests/th/T10596.hs
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskell #-}
+module T10596 where
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+do
+  putQ (100 :: Int)
+  x <- (getQ :: Q (Maybe Int))
+
+  -- It should print "Just 100"
+  runIO $ print x
+  return []
diff --git a/testsuite/tests/th/T10596.stderr b/testsuite/tests/th/T10596.stderr
new file mode 100644
index 0000000..4b58162
--- /dev/null
+++ b/testsuite/tests/th/T10596.stderr
@@ -0,0 +1 @@
+Just 100
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 084ace5..1ec99d5 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -345,3 +345,4 @@ test('T10047', normal, ghci_script, ['T10047.script'])
 test('T10019', normal, ghci_script, ['T10019.script'])
 test('T10279', normal, compile_fail, ['-v0'])
 test('T10306', normal, compile, ['-v0'])
+test('T10596', normal, compile, ['-v0'])