Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
07b041b8
Commit
07b041b8
authored
Apr 25, 2012
by
Simon Peyton Jones
Browse files
Merge branch 'master' of
http://darcs.haskell.org/testsuite
parents
2ceaa814
279a594f
Changes
11
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/deriving/should_compile/T6031.hs
View file @
07b041b8
{-# LANGUAGE StandaloneDeriving #-}
module
T6031
where
import
T6031a
deriving
instance
Show
Empty
{-# LANGUAGE StandaloneDeriving #-}
module
T6031
where
import
T6031a
deriving
instance
Show
Empty
testsuite/tests/deriving/should_compile/T6031a.hs
View file @
07b041b8
module
T6031a
where
data
Empty
module
T6031a
where
data
Empty
testsuite/tests/deriving/should_compile/all.T
View file @
07b041b8
...
...
@@ -30,5 +30,4 @@ test('T4966', normal, compile, [''])
test
('
drv-functor1
',
normal
,
compile
,
[''])
test
('
drv-functor2
',
normal
,
compile
,
[''])
test
('
drv-foldable-traversable1
',
normal
,
compile
,
[''])
test
('
T6031
',
extra_clean
(['
T6031.o
',
'
T6031.hi
']),
multimod_compile
,
['
T6031
',
'
-v0
'])
test
('
T6031
',
extra_clean
(['
T6031a.o
',
'
T6031a.hi
']),
multimod_compile
,
['
T6031
',
'
-v0
'])
testsuite/tests/polykinds/T6020.hs
View file @
07b041b8
{-# LANGUAGE DataKinds, FunctionalDependencies, FlexibleInstances,
UndecidableInstances, PolyKinds, KindSignatures,
ConstraintKinds, FlexibleContexts #-}
module
T6020
where
class
Id
(
a
::
k
)
(
b
::
k
)
|
a
->
b
instance
Id
a
a
class
Test
(
x
::
a
)
(
y
::
a
)
|
x
->
y
instance
(
Id
x
y
,
Id
y
z
)
=>
Test
x
z
test
::
Test
True
True
=>
()
test
=
()
{-# LANGUAGE DataKinds, FunctionalDependencies, FlexibleInstances,
UndecidableInstances, PolyKinds, KindSignatures,
ConstraintKinds, FlexibleContexts #-}
module
T6020
where
class
Id
(
a
::
k
)
(
b
::
k
)
|
a
->
b
instance
Id
a
a
class
Test
(
x
::
a
)
(
y
::
a
)
|
x
->
y
instance
(
Id
x
y
,
Id
y
z
)
=>
Test
x
z
test
::
Test
True
True
=>
()
test
=
()
testsuite/tests/polykinds/T6035.hs
0 → 100644
View file @
07b041b8
{-# LANGUAGE PolyKinds, DataKinds, TypeFamilies, KindSignatures, GADTs, TypeOperators
#-}
module
T6035
where
data
Nat
=
Zero
|
Succ
Nat
type
family
Sing
(
a
::
k
)
::
k
->
*
data
SNat
n
where
SZero
::
SNat
Zero
SSucc
::
SNat
n
->
SNat
(
Succ
n
)
data
SList
(
a
::
[
k
])
where
SNil
::
SList
'
[]
SCons
::
Sing
h
h
->
SList
t
->
SList
(
h
'
:
t
)
type
instance
Sing
(
a
::
Nat
)
=
SNat
type
instance
Sing
(
a
::
[
k
])
=
SList
nil
::
SList
'
[]
nil
=
SNil
zero
::
SList
'
[
'
[]
]
zero
=
SCons
SNil
SNil
term
::
SList
'
[
'
[
Zero
],
'
[]
]
term
=
SCons
(
SCons
SZero
SNil
)
(
SCons
SNil
SNil
)
testsuite/tests/polykinds/T6036.hs
0 → 100644
View file @
07b041b8
{-# LANGUAGE DataKinds, TypeFamilies, PolyKinds, GADTs #-}
module
T6036
where
data
family
Sing
(
a
::
k
)
data
instance
Sing
(
a
::
Maybe
k
)
where
SNothing
::
Sing
'Nothing
SJust
::
Sing
b
->
Sing
(
'Just
b
)
data
Nat
=
Zero
|
Succ
Nat
data
instance
Sing
(
a
::
Nat
)
where
SZero
::
Sing
Zero
SSucc
::
Sing
n
->
Sing
(
Succ
n
)
term
=
SJust
SZero
testsuite/tests/polykinds/all.T
View file @
07b041b8
...
...
@@ -35,6 +35,8 @@ test('T5935', normal, compile, [''])
test
('
T5938
',
normal
,
compile
,
[''])
test
('
T5948
',
normal
,
compile
,
[''])
test
('
T6020
',
normal
,
compile
,
[''])
test
('
T6035
',
normal
,
compile
,
[''])
test
('
T6036
',
normal
,
compile
,
[''])
test
('
T6025
',
normal
,
run_command
,
['
$MAKE -s --no-print-directory T6025
'])
test
('
T6002
',
normal
,
compile
,
[''])
test
('
T6039
',
normal
,
compile_fail
,
[''])
testsuite/tests/typecheck/should_compile/tc231.stderr
View file @
07b041b8
...
...
@@ -19,7 +19,7 @@ TYPE CONSTRUCTORS
RecFlag NonRecursive
huh :: forall chain. Q s a chain -> ST s ()
COERCION AXIOMS
axiom ShouldCompile.NTCo:Zork
[s,
a
,
b
]
axiom ShouldCompile.NTCo:Zork
s
a b
:: Zork s a b ~# (forall chain. Q s a chain -> ST s ())
Dependent modules: []
Dependent packages: [base, ghc-prim, integer-gmp]
testsuite/tests/typecheck/should_fail/T6022.hs
0 → 100644
View file @
07b041b8
module
T6022
where
f
x
=
x
==
head
testsuite/tests/typecheck/should_fail/T6022.stderr
0 → 100644
View file @
07b041b8
T6022.hs:3:9:
No instance for (Eq ([a] -> a)) arising from a use of `=='
Possible fix: add an instance declaration for (Eq ([a] -> a))
In the expression: x == head
In an equation for `f': f x = x == head
testsuite/tests/typecheck/should_fail/all.T
View file @
07b041b8
...
...
@@ -274,4 +274,5 @@ test('T5684', normal, compile_fail, [''])
test
('
T5858
',
normal
,
compile_fail
,
[''])
test
('
T5957
',
normal
,
compile_fail
,
[''])
test
('
T6001
',
normal
,
compile_fail
,
[''])
test
('
T6022
',
expect_broken
(
6022
),
compile_fail
,
[''])
test
('
T5853
',
normal
,
compile_fail
,
[''])
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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