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
ccf26508
Commit
ccf26508
authored
Aug 13, 2010
by
simonpj
Browse files
Test Trac
#3959
parent
2baf8aa7
Changes
3
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/simplCore/should_run/T3959.hs
0 → 100644
View file @
ccf26508
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
module
Main
(
main
,
f
)
where
import
Data.List
(
isPrefixOf
)
import
Data.Dynamic
import
Control.Exception
as
E
data
Failure
=
Failure
deriving
(
Show
,
Typeable
)
instance
Exception
Failure
test
=
(
E
.
throw
Failure
>>
return
()
)
`
E
.
catch
`
(
\
(
x
::
Failure
)
->
return
()
)
main
::
IO
()
main
=
print
=<<
test
f
::
Bool
->
Bool
->
Bool
f
True
=
error
"urk"
-- f False = \y -> y
{-
Uderlying cause: we call
catch# thing handler
and expect that (thing state-token) will
- either diverge/throw an exception
- or return (# x,y #)
But it does neither: it returns a PAP, because
thing = \p q. blah
In particular, 'thing = lvl_sxo' is
lvl_sxc :: IO Any
lvl_sxc = error "urk"
lvl_sxo :: IO ()
= lvl_sxc >> return ()
-- inline (>>) --
= (\(eta::S#). case lvl_sxc |> g1 eta of ...) |> g2
where
g1 :: IO Any ~ S# -> (# S#, Any #)
g2 :: S# -> (# S#, () #) -> IO ()
-- case-of-bottomming function --
= (\ (eta::S#). lvl_sxc |> g1 |> ug3) |> g2
where
ug3(unsafe) :: S# -> (S#, Any) ~ (# S#, () #)
This is all fine. But it's crucial that lvl_sxc actually diverges.
Do not eta-expand it to
lvl_sxc :: IO Any
lvl_sxc = \eta. error "urk" |> ug4
where
ug4(unsafe) :: S# -> (# S#, Any #) ~ IO Any
In contrast, if we had
case x of
True -> \a -> 3
False -> error "urk"
we can, and must, eta-expand the error
-}
\ No newline at end of file
testsuite/tests/ghc-regress/simplCore/should_run/T3959.stdout
0 → 100644
View file @
ccf26508
()
testsuite/tests/ghc-regress/simplCore/should_run/all.T
View file @
ccf26508
...
...
@@ -35,6 +35,7 @@ test('T3403', normal, compile_and_run, ['-package containers'])
test
('
T3591
',
normal
,
compile_and_run
,
[''])
# Run this test *without* optimisation too
test
('
T3959
',
only_ways
(['
normal
','
optc
','
optasm
']),
compile_and_run
,
[''])
test
('
T3983
',
[
only_ways
(['
normal
','
optc
','
optasm
']),
extra_clean
(['
T3983_Foo.hi
','
T3983_Foo.o
','
T3983_Bar.hi
','
T3983_Bar.o
',])],
multimod_compile_and_run
,
...
...
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