Skip to content
GitLab
Menu
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
902cf01b
Commit
902cf01b
authored
Aug 05, 2013
by
eir@cis.upenn.edu
Browse files
Added test cases for closed type families in .hs-boot files.
parent
fd20b873
Changes
12
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/deriving/should_fail/Roles12.stderr
View file @
902cf01b
Roles12.hs:5:6:
Type constructor ‛T’ has conflicting definitions in the module and its hs-boot file
Type constructor ‛T’ has conflicting definitions in the module
and its hs-boot file
Main module: data T a@P
No C type associated
RecFlag Recursive, Promotable
...
...
testsuite/tests/indexed-types/should_compile/ClosedFam1.hs
0 → 100644
View file @
902cf01b
{-# LANGUAGE TypeFamilies #-}
module
ClosedFam1
where
import
{-#
SOURCE
#-
}
ClosedFam1
type
family
Foo
a
where
Foo
Int
=
Bool
Foo
[
a
]
=
Maybe
a
\ No newline at end of file
testsuite/tests/indexed-types/should_compile/ClosedFam1.hs-boot
0 → 100644
View file @
902cf01b
{-# LANGUAGE TypeFamilies #-}
module
ClosedFam1
where
type
family
Foo
b
where
Foo
Int
=
Bool
Foo
[
different
]
=
Maybe
different
\ No newline at end of file
testsuite/tests/indexed-types/should_compile/ClosedFam2.hs
0 → 100644
View file @
902cf01b
{-# LANGUAGE TypeFamilies #-}
module
ClosedFam2
where
import
{-#
SOURCE
#-
}
ClosedFam2
type
family
Foo
a
where
Foo
Int
=
Bool
Foo
[
a
]
=
Maybe
a
\ No newline at end of file
testsuite/tests/indexed-types/should_compile/ClosedFam2.hs-boot
0 → 100644
View file @
902cf01b
{-# LANGUAGE TypeFamilies #-}
module
ClosedFam2
where
type
family
Foo
b
where
..
testsuite/tests/indexed-types/should_compile/all.T
View file @
902cf01b
...
...
@@ -227,4 +227,8 @@ test('T8011',
['
$MAKE -s --no-print-directory T8011
'])
test
('
T8018
',
normal
,
compile
,
[''])
test
('
T8020
',
normal
,
compile
,
[''])
\ No newline at end of file
test
('
T8020
',
normal
,
compile
,
[''])
test
('
ClosedFam1
',
extra_clean
(['
ClosedFam1.o-boot
',
'
ClosedFam1.hi-boot
']),
multimod_compile
,
['
ClosedFam1
',
'
-v0
'])
test
('
ClosedFam2
',
extra_clean
(['
ClosedFam2.o-boot
',
'
ClosedFam2.hi-boot
']),
multimod_compile
,
['
ClosedFam2
',
'
-v0
'])
\ No newline at end of file
testsuite/tests/indexed-types/should_fail/ClosedFam3.hs
0 → 100644
View file @
902cf01b
{-# LANGUAGE TypeFamilies #-}
module
ClosedFam3
where
import
{-#
SOURCE
#-
}
ClosedFam3
type
family
Foo
a
where
Foo
Int
=
Bool
Foo
Double
=
Char
type
family
Bar
a
where
Bar
Int
=
Bool
Bar
Double
=
Double
type
family
Baz
a
where
Baz
Int
=
Bool
\ No newline at end of file
testsuite/tests/indexed-types/should_fail/ClosedFam3.hs-boot
0 → 100644
View file @
902cf01b
{-# LANGUAGE TypeFamilies, PolyKinds #-}
module
ClosedFam3
where
type
family
Foo
a
where
Foo
Int
=
Bool
type
family
Bar
a
where
Bar
Int
=
Bool
Bar
Double
=
Char
type
family
Baz
(
a
::
k
)
where
Baz
Int
=
Bool
\ No newline at end of file
testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
0 → 100644
View file @
902cf01b
ClosedFam3.hs-boot:5:13:
Type constructor ‛Foo’ has conflicting definitions in the module
and its hs-boot file
Main module: closed type family Foo a@N :: * where
Foo Int = Bool
Foo Double = Char
Boot file: closed type family Foo a@N :: * where Foo Int = Bool
ClosedFam3.hs-boot:8:13:
Type constructor ‛Bar’ has conflicting definitions in the module
and its hs-boot file
Main module: closed type family Bar a@N :: * where
Bar Int = Bool
Bar Double = Double
Boot file: closed type family Bar a@N :: * where
Bar Int = Bool
Bar Double = Char
ClosedFam3.hs-boot:12:13:
Type constructor ‛Baz’ has conflicting definitions in the module
and its hs-boot file
Main module: closed type family Baz a@N :: * where Baz Int = Bool
Boot file: closed type family Baz (k::BOX)@N (a::k)@N :: * where
Baz * Int = Bool
testsuite/tests/indexed-types/should_fail/ClosedFam4.hs
0 → 100644
View file @
902cf01b
{-# LANGUAGE TypeFamilies #-}
module
ClosedFam4
where
type
family
Foo
a
where
..
\ No newline at end of file
testsuite/tests/indexed-types/should_fail/ClosedFam4.stderr
0 → 100644
View file @
902cf01b
ClosedFam4.hs:5:1:
You may omit the equations in a closed type family
only in a .hs-boot file
In the family declaration for ‛Foo’
testsuite/tests/indexed-types/should_fail/all.T
View file @
902cf01b
...
...
@@ -100,4 +100,8 @@ test('T7786', normal, compile_fail, [''])
test
('
NoGood
',
normal
,
compile_fail
,
[''])
test
('
T7967
',
normal
,
compile_fail
,
[''])
test
('
T7938
',
normal
,
compile_fail
,
[''])
\ No newline at end of file
test
('
T7938
',
normal
,
compile_fail
,
[''])
test
('
ClosedFam3
',
extra_clean
(['
ClosedFam3.o-boot
',
'
ClosedFam3.hi-boot
']),
multimod_compile_fail
,
['
ClosedFam3
',
'
-v0
'])
test
('
ClosedFam4
',
normal
,
compile_fail
,
[''])
\ No newline at end of file
Write
Preview
Supports
Markdown
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