Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
f9d25f56
Commit
f9d25f56
authored
Jun 16, 2011
by
Simon Peyton Jones
Browse files
Test Trac
#5037
parent
eb6f5d31
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/th/T5037.hs
0 → 100644
View file @
f9d25f56
{-# LANGUAGE TemplateHaskell #-}
module
T5037
where
import
Language.Haskell.TH
import
System.IO
$
(
do
ds
<-
[
d
|
f :: Maybe Int -> Int
f Nothing = 3
f (Just x) = $(varE (mkName "x"))
|]
runIO
$
(
putStrLn
(
pprint
ds
)
>>
hFlush
stdout
)
return
ds
)
testsuite/tests/ghc-regress/th/T5037.stderr
0 → 100644
View file @
f9d25f56
f :: Data.Maybe.Maybe GHC.Types.Int -> GHC.Types.Int
f (Data.Maybe.Nothing) = 3
f (Data.Maybe.Just x_0) = x
testsuite/tests/ghc-regress/th/all.T
View file @
f9d25f56
...
...
@@ -180,3 +180,4 @@ test('T4436', normal, compile, ['-v0 -ddump-splices'])
test
('
T4949
',
normal
,
compile
,
['
-v0
'])
test
('
T5126
',
normal
,
compile
,
['
-v0
'])
test
('
T5217
',
normal
,
compile
,
['
-v0 -dsuppress-uniques -ddump-splices
'])
test
('
T5037
',
normal
,
compile
,
['
-v0
'])
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment