Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alex D
GHC
Commits
cde88e20
Commit
cde88e20
authored
Feb 11, 2014
by
Joachim Breitner
Browse files
Test case: Looking through unfoldings when matching lambdas
parent
a27b2985
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/simplCore/should_run/all.T
View file @
cde88e20
...
...
@@ -21,6 +21,7 @@ test('simplrun009', normal, compile_and_run, [''])
test
('
simplrun010
',
[
extra_run_opts
('
24 16 8 +RTS -M10m -RTS
'),
exit_code
(
251
)]
,
compile_and_run
,
[''])
test
('
simplrun011
',
normal
,
compile_and_run
,
[''])
# Really we'd like to run T2486 too, to check that its
# runtime has not gone up, but here I just compile it so that
...
...
testsuite/tests/simplCore/should_run/simplrun011.hs
0 → 100644
View file @
cde88e20
module
Main
where
import
GHC.Exts
-- This checks that rules look through unfoldings when matching
-- lambdas, but only in the right phase
foo
::
(
Int
->
IO
()
)
->
IO
()
foo
f
=
putStr
"not fired: "
>>
f
0
{-# NOINLINE foo #-}
f1
::
Int
->
IO
()
f1
_
=
putStrLn
"f1"
{-# NOINLINE[0] f1 #-}
f2
::
Int
->
IO
()
f2
_
=
putStrLn
"f2"
{-# NOINLINE f2 #-}
newtype
Age
=
MkAge
Int
-- It also checks that this can look through casted lambdas
f3
::
Age
->
IO
()
f3
_
=
putStrLn
"f3"
{-# NOINLINE[0] f3 #-}
{-# RULES "foo" [0] forall g . foo (\x -> g) = putStr "fired: " >> g #-}
main
=
do
foo
f1
foo
f1
foo
f2
foo
f2
foo
(
coerce
f3
)
foo
(
coerce
f3
)
testsuite/tests/simplCore/should_run/simplrun011.stdout
0 → 100644
View file @
cde88e20
fired: f1
fired: f1
not fired: f2
not fired: f2
fired: f3
fired: f3
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