Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
b9328630
Commit
b9328630
authored
Mar 24, 2009
by
chak@cse.unsw.edu.au.
Browse files
TH: test for pragma support
parent
9d720fbb
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/th/TH_pragma.hs
0 → 100644
View file @
b9328630
module
TH_pragma
where
$
(
[
d
|
foo :: Int -> Int
{-# NOINLINE foo #-}
foo x = x + 1
|]
)
$
(
[
d
|
bar :: Num a => a -> a
{-# SPECIALISE INLINE [~1] bar :: Float -> Float #-}
bar x = x * 10
|]
)
testsuite/tests/ghc-regress/th/TH_pragma.stderr
0 → 100644
View file @
b9328630
TH_pragma.hs:1:0:
TH_pragma.hs:1:0: Splicing declarations
[d| foo :: Int -> Int
{-# NOINLINE foo #-}
foo x = x + 1 |]
======>
TH_pragma.hs:(4,3)-(6,25)
foo :: GHC.Types.Int -> GHC.Types.Int
{-# NOINLINE foo #-}
foo x[] = (x[] `GHC.Num.+` 1)
TH_pragma.hs:1:0:
TH_pragma.hs:1:0: Splicing declarations
[d| bar :: (Num a) => a -> a
{-# SPECIALIZE INLINE [~1] bar :: Float -> Float #-}
bar x = x * 10 |]
======>
TH_pragma.hs:(8,3)-(10,30)
bar :: forall a[]. (GHC.Num.Num a[]) => a[] -> a[]
{-# SPECIALIZE INLINE [~1] bar ::
GHC.Types.Float -> GHC.Types.Float #-}
bar x[] = (x[] `GHC.Num.*` 10)
testsuite/tests/ghc-regress/th/all.T
View file @
b9328630
...
...
@@ -137,3 +137,5 @@ test('TH_sections', normal, compile, ['-v0'])
test
('
TH_tf1
',
if_compiler_lt
('
ghc
',
'
6.11
',
expect_fail
),
compile
,
['
-v0
'])
test
('
TH_tf2
',
if_compiler_lt
('
ghc
',
'
6.11
',
expect_fail
),
compile
,
['
-v0
'])
test
('
TH_tf3
',
if_compiler_lt
('
ghc
',
'
6.11
',
expect_fail
),
compile
,
['
-v0
'])
test
('
TH_pragma
',
normal
,
compile
,
['
-v0 -ddump-splices -dsuppress-uniques -S
'])
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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