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
48d5e116
Commit
48d5e116
authored
Sep 17, 2010
by
simonpj
Browse files
Add test for Trac
#4160
parent
df8ed7e1
Changes
2
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/ghc-regress/indexed-types/should_compile/T4160.hs
0 → 100644
View file @
48d5e116
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-}
module
Foo
where
data
P
f
g
r
=
f
r
:*:
g
r
type
family
TrieMapT
(
f
::
*
->
*
)
::
*
->
(
*
->
*
)
->
*
->
*
newtype
PMap
m1
(
m2
::
*
->
(
*
->
*
)
->
*
->
*
)
k
(
a
::
*
->
*
)
ix
=
PMap
(
m1
k
(
m2
k
a
)
ix
)
type
instance
TrieMapT
(
P
f
g
)
=
PMap
(
TrieMapT
f
)
(
TrieMapT
g
)
class
TrieKeyT
f
m
where
unionT
::
(
TrieMapT
f
~
m
)
=>
(
f
k
->
a
ix
->
a
ix
->
a
ix
)
->
m
k
a
ix
->
m
k
a
ix
->
m
k
a
ix
sizeT
::
(
TrieMapT
f
~
m
)
=>
m
k
a
ix
->
Int
instance
(
TrieKeyT
f
m1
,
TrieKeyT
g
m2
)
=>
TrieKeyT
(
P
f
g
)
(
PMap
m1
m2
)
where
unionT
f
(
PMap
m1
)
(
PMap
m2
)
=
PMap
(
uT
(
\
a
->
unionT
(
\
b
->
f
(
a
:*:
b
)))
m1
m2
)
where
uT
=
unionT
sizeT
=
error
"urk"
testsuite/tests/ghc-regress/indexed-types/should_compile/all.T
View file @
48d5e116
...
...
@@ -139,6 +139,7 @@ test('T3220', if_compiler_lt('ghc', '6.11', expect_fail), compile, [''])
test
('
T3590
',
normal
,
compile
,
[''])
test
('
CoTest3
',
if_compiler_lt
('
ghc
',
'
6.13
',
expect_fail
),
compile
,
[''])
test
('
Roman1
',
if_compiler_lt
('
ghc
',
'
6.13
',
expect_fail
),
compile
,
[''])
test
('
T4160
',
normal
,
compile
,
[''])
test
('
IndTypesPerf
',
extra_clean
(['
IndTypesPerf.o
',
'
IndTypesPerf.hi
',
'
IndTypesPerfMerge.o
',
'
IndTypesPerfMerge.hi
']),
...
...
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