Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
3658339a
Commit
3658339a
authored
Nov 21, 2007
by
simonpj
Browse files
Update for rebindable changes (Trac #1537)
parent
a718f4a0
Changes
4
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/rebindable/all.T
View file @
3658339a
...
...
@@ -14,4 +14,4 @@ test('rebindable4', normal, compile_and_run, [''])
test
('
rebindable5
',
normal
,
compile_and_run
,
[''])
test
('
rebindable6
',
normal
,
compile_and_run
,
[''])
test
('
rebindable7
',
normal
,
compile_and_run
,
[''])
test
('
rebindable8
',
expect_broken
(
1537
),
compile
,
[''])
\ No newline at end of file
test
('
rebindable8
',
normal
,
compile
,
[''])
testsuite/tests/ghc-regress/rebindable/rebindable5.hs
View file @
3658339a
...
...
@@ -16,6 +16,9 @@ module Main where
infixl
1
>>=
;
infixl
1
>>
;
returnIO
::
a
->
IO
a
;
returnIO
=
Prelude
.
return
;
class
HasReturn
m
where
{
return
::
a
->
m
a
;
...
...
@@ -38,7 +41,7 @@ module Main where
instance
HasReturn
IO
where
{
return
a
=
debugFunc
"return"
(
Prelude
.
return
a
);
return
a
=
debugFunc
"return"
(
return
IO
a
);
};
instance
HasBind
IO
IO
IO
where
...
...
@@ -53,7 +56,7 @@ module Main where
instance
HasFail
IO
where
{
fail
s
=
debugFunc
"fail"
(
Prelude
.
return
undefined
);
fail
s
=
debugFunc
"fail"
(
return
IO
undefined
);
-- fail s = debugFunc "fail" (Prelude.fail s);
};
...
...
@@ -146,11 +149,11 @@ module Main where
main
::
IO
()
;
main
=
(
doTest
"test_do failure"
(
test_do
(
Prelude
.
return
()
)
(
Prelude
.
return
Nothing
))
(
test_do
(
return
IO
()
)
(
return
IO
Nothing
))
)
Prelude
.>>
(
doTest
"test_do success"
(
test_do
(
Prelude
.
return
()
)
(
Prelude
.
return
(
Just
()
)))
(
test_do
(
return
IO
()
)
(
return
IO
(
Just
()
)))
)
Prelude
.>>
(
doTest
"test_fromInteger"
...
...
testsuite/tests/ghc-regress/rebindable/rebindable6.hs
View file @
3658339a
...
...
@@ -16,6 +16,9 @@ module Main where
infixl
1
>>=
;
infixl
1
>>
;
returnIO
::
a
->
IO
a
;
returnIO
=
Prelude
.
return
;
class
HasReturn
a
where
{
return
::
a
;
...
...
@@ -97,12 +100,12 @@ module Main where
(
-
)
x
y
=
y
;
-- changed function
};
test_do
::
IO
a
->
IO
(
Maybe
b
)
->
IO
b
;
test_do
::
forall
a
b
.
IO
a
->
IO
(
Maybe
b
)
->
IO
b
;
test_do
f
g
=
do
{
f
;
-- >>
Just
a
<-
g
;
-- >>= (and fail if g returns Nothing)
return
a
;
-- return
f
;
-- >>
Just
(
b
::
b
)
<-
g
;
-- >>= (and fail if g returns Nothing)
return
b
;
-- return
};
test_fromInteger
::
Integer
;
...
...
testsuite/tests/ghc-regress/rebindable/rebindable8.hs
View file @
3658339a
...
...
@@ -23,4 +23,4 @@ instance Return [] where
should_compile
::
[
Int
]
should_compile
=
do
a
<-
Just
1
[
a
]
\ No newline at end of file
[
a
]
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