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
235e410f
Commit
235e410f
authored
Sep 29, 2020
by
Richard Eisenberg
Committed by
Marge Bot
Sep 30, 2020
Browse files
Regression test for #10709.
Close #10709
parent
39549826
Changes
5
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/typecheck/should_fail/T10709.hs
0 → 100644
View file @
235e410f
module
T10709
where
import
GHC.IO
import
Control.Monad
x1
=
replicateM
2
.
mask
x2
=
(
replicateM
2
.
mask
)
undefined
x3
=
(
replicateM
2
.
mask
)
$
undefined
testsuite/tests/typecheck/should_fail/T10709.stderr
0 → 100644
View file @
235e410f
T10709.hs:6:21: error:
• Couldn't match type ‘a4’ with ‘(forall a. IO a -> IO a) -> IO a5’
Expected: a4 -> IO a5
Actual: ((forall a. IO a -> IO a) -> IO a5) -> IO a5
Cannot instantiate unification variable ‘a4’
with a type involving polytypes: (forall a. IO a -> IO a) -> IO a5
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: replicateM 2 . mask
In an equation for ‘x1’: x1 = replicateM 2 . mask
• Relevant bindings include
x1 :: a4 -> IO [a5] (bound at T10709.hs:6:1)
T10709.hs:7:22: error:
• Couldn't match type ‘a2’ with ‘(forall a. IO a -> IO a) -> IO a3’
Expected: a2 -> IO a3
Actual: ((forall a. IO a -> IO a) -> IO a3) -> IO a3
Cannot instantiate unification variable ‘a2’
with a type involving polytypes: (forall a. IO a -> IO a) -> IO a3
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: (replicateM 2 . mask) undefined
In an equation for ‘x2’: x2 = (replicateM 2 . mask) undefined
• Relevant bindings include x2 :: IO [a3] (bound at T10709.hs:7:1)
T10709.hs:8:22: error:
• Couldn't match type ‘a0’ with ‘(forall a. IO a -> IO a) -> IO a1’
Expected: a0 -> IO a1
Actual: ((forall a. IO a -> IO a) -> IO a1) -> IO a1
Cannot instantiate unification variable ‘a0’
with a type involving polytypes: (forall a. IO a -> IO a) -> IO a1
• In the second argument of ‘(.)’, namely ‘mask’
In the first argument of ‘($)’, namely ‘(replicateM 2 . mask)’
In the expression: (replicateM 2 . mask) $ undefined
• Relevant bindings include x3 :: IO [a1] (bound at T10709.hs:8:1)
testsuite/tests/typecheck/should_fail/T10709b.hs
0 → 100644
View file @
235e410f
module
T10709b
where
import
GHC.IO
import
Control.Monad
x4
=
(
replicateM
2
.
mask
)
(
\
_
->
return
()
)
x5
=
(
replicateM
2
.
mask
)
(
\
x
->
undefined
x
)
x6
=
(
replicateM
2
.
mask
)
(
id
(
\
_
->
undefined
))
x7
=
(
replicateM
2
.
mask
)
(
const
undefined
)
x8
=
(
replicateM
2
.
mask
)
((
\
x
->
undefined
x
)
::
a
->
b
)
testsuite/tests/typecheck/should_fail/T10709b.stderr
0 → 100644
View file @
235e410f
T10709b.hs:6:22: error:
• Couldn't match type ‘p1’ with ‘forall a. IO a -> IO a’
Expected: (p1 -> IO ()) -> IO ()
Actual: ((forall a. IO a -> IO a) -> IO ()) -> IO ()
Cannot instantiate unification variable ‘p1’
with a type involving polytypes: forall a. IO a -> IO a
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: (replicateM 2 . mask) (\ _ -> return ())
In an equation for ‘x4’:
x4 = (replicateM 2 . mask) (\ _ -> return ())
T10709b.hs:7:22: error:
• Couldn't match type ‘t0’ with ‘forall a. IO a -> IO a’
Expected: (t0 -> IO a) -> IO a
Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a
Cannot instantiate unification variable ‘t0’
with a type involving polytypes: forall a. IO a -> IO a
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: (replicateM 2 . mask) (\ x -> undefined x)
In an equation for ‘x5’:
x5 = (replicateM 2 . mask) (\ x -> undefined x)
T10709b.hs:8:22: error:
• Couldn't match type ‘p0’ with ‘forall a. IO a -> IO a’
Expected: (p0 -> IO a) -> IO a
Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a
Cannot instantiate unification variable ‘p0’
with a type involving polytypes: forall a. IO a -> IO a
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: (replicateM 2 . mask) (id (\ _ -> undefined))
In an equation for ‘x6’:
x6 = (replicateM 2 . mask) (id (\ _ -> undefined))
T10709b.hs:9:22: error:
• Couldn't match type ‘b0’ with ‘forall a. IO a -> IO a’
Expected: (b0 -> IO a) -> IO a
Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a
Cannot instantiate unification variable ‘b0’
with a type involving polytypes: forall a. IO a -> IO a
• In the second argument of ‘(.)’, namely ‘mask’
In the expression: (replicateM 2 . mask) (const undefined)
In an equation for ‘x7’:
x7 = (replicateM 2 . mask) (const undefined)
T10709b.hs:10:22: error:
• Couldn't match type ‘a0’ with ‘forall a. IO a -> IO a’
Expected: (a0 -> IO a) -> IO a
Actual: ((forall a1. IO a1 -> IO a1) -> IO a) -> IO a
Cannot instantiate unification variable ‘a0’
with a type involving polytypes: forall a. IO a -> IO a
• In the second argument of ‘(.)’, namely ‘mask’
In the expression:
(replicateM 2 . mask) ((\ x -> undefined x) :: a -> b)
In an equation for ‘x8’:
x8 = (replicateM 2 . mask) ((\ x -> undefined x) :: a -> b)
testsuite/tests/typecheck/should_fail/all.T
View file @
235e410f
...
...
@@ -584,3 +584,5 @@ test('too-many', normal, compile_fail, [''])
test
('
T18640a
',
normal
,
compile_fail
,
[''])
test
('
T18640b
',
normal
,
compile_fail
,
[''])
test
('
T18640c
',
normal
,
compile_fail
,
[''])
test
('
T10709
',
normal
,
compile_fail
,
[''])
test
('
T10709b
',
normal
,
compile_fail
,
[''])
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