Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/deea5794a37ac212b7c8db194924875043e3a5df >--------------------------------------------------------------- commit deea5794a37ac212b7c8db194924875043e3a5df Author: Simon Peyton Jones <[email protected]> Date: Tue Aug 28 13:31:57 2012 +0100 Test Trac #7092 >--------------------------------------------------------------- tests/th/T7092.hs | 10 ++++++++++ tests/th/T7092a.hs | 12 ++++++++++++ tests/th/all.T | 2 ++ 3 files changed, 24 insertions(+), 0 deletions(-) diff --git a/tests/th/T7092.hs b/tests/th/T7092.hs new file mode 100644 index 0000000..78c4a78 --- /dev/null +++ b/tests/th/T7092.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fwarn-name-shadowing #-} + +-- Should not produce a name-shadowing warning (GHC 7.4 did) + +module T7092 where + +import T7092a + +blah = $(code) diff --git a/tests/th/T7092a.hs b/tests/th/T7092a.hs new file mode 100644 index 0000000..abe7931 --- /dev/null +++ b/tests/th/T7092a.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE TemplateHaskell #-} +module T7092a where + +import Language.Haskell.TH + +code :: Q Exp +code = do + n1 <- newName "foo" + n2 <- newName "foo" + letE [valD (varP n1) (normalB [| (1 :: Int) |]) []] + $ letE [valD (varP n2) (normalB [| (2 :: Int) |]) []] + $ appE (appE [| ((+) :: Int -> Int -> Int)|] (varE n1)) (varE n2) diff --git a/tests/th/all.T b/tests/th/all.T index 1f0dee0..46cdc59 100644 --- a/tests/th/all.T +++ b/tests/th/all.T @@ -250,3 +250,5 @@ test('T7064', extra_clean(['T7064a.hi', 'T7064a.o']), multimod_compile_and_run, ['T7064.hs', '-v0']) +test('T7092', extra_clean(['T7092a.hi','T7092a.o']), + multimod_compile, ['T7092','-v0']) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
