Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
obsidiansystems
GHC
Commits
1e3ca733
Commit
1e3ca733
authored
Aug 28, 2013
by
Richard Eisenberg
Committed by
eir@cis.upenn.edu
Sep 17, 2013
Browse files
Update to tests due to change in syntax for role annotations.
parent
b4ab30d5
Changes
66
Hide whitespace changes
Inline
Side-by-side
testsuite/tests/deriving/should_compile/all.T
View file @
1e3ca733
...
...
@@ -41,9 +41,4 @@ test('T7710', normal, compile, [''])
test
('
AutoDeriveTypeable
',
normal
,
compile
,
[''])
test
('
Roles1
',
only_ways
('
normal
'),
compile
,
['
-ddump-tc
'])
test
('
Roles2
',
only_ways
('
normal
'),
compile
,
['
-ddump-tc
'])
test
('
Roles3
',
only_ways
('
normal
'),
compile
,
['
-ddump-tc
'])
test
('
Roles4
',
only_ways
('
normal
'),
compile
,
['
-ddump-tc
'])
test
('
Roles13
',
only_ways
('
normal
'),
compile
,
['
-ddump-simpl -dsuppress-uniques
'])
test
('
T8138
',
normal
,
compile
,
['
-O2
'])
\ No newline at end of file
testsuite/tests/deriving/should_fail/Roles5.hs
deleted
100644 → 0
View file @
b4ab30d5
module
Roles5
where
data
T
a
@
N
class
C
a
@
R
type
S
a
@
P
=
Int
\ No newline at end of file
testsuite/tests/deriving/should_fail/Roles5.stderr
deleted
100644 → 0
View file @
b4ab30d5
Roles5.hs:3:8:
Illegal role annotation
Perhaps you intended to use RoleAnnotations
In the data type declaration for ‛T’
Roles5.hs:4:9:
Illegal role annotation
Perhaps you intended to use RoleAnnotations
In the declaration for class C
Roles5.hs:5:8:
Illegal role annotation
Perhaps you intended to use RoleAnnotations
In the declaration for type synonym ‛S’
testsuite/tests/deriving/should_fail/Roles6.hs
deleted
100644 → 0
View file @
b4ab30d5
{-# LANGUAGE RoleAnnotations, TypeFamilies #-}
module
Roles6
where
type
family
F
a
@
R
testsuite/tests/deriving/should_fail/Roles6.stderr
deleted
100644 → 0
View file @
b4ab30d5
Roles6.hs:5:1:
Illegal role annotation on variable a;
role annotations are not allowed here
In the family declaration for ‛F’
testsuite/tests/deriving/should_fail/Roles7.stderr
deleted
100644 → 0
View file @
b4ab30d5
Roles7.hs:5:8:
Illegal role annotation on Int
In the type signature for ‛bar’
testsuite/tests/deriving/should_fail/Roles8.stderr
deleted
100644 → 0
View file @
b4ab30d5
Roles8.hs:5:1:
Role mismatch on variable a:
Annotation says Phantom but role Representational is required
In the data declaration for ‛T1’
testsuite/tests/deriving/should_fail/all.T
View file @
1e3ca733
...
...
@@ -42,16 +42,6 @@ test('T1133A',
test
('
T5863a
',
normal
,
compile_fail
,
[''])
test
('
T7959
',
normal
,
compile_fail
,
[''])
test
('
Roles5
',
normal
,
compile_fail
,
[''])
test
('
Roles6
',
normal
,
compile_fail
,
[''])
test
('
Roles7
',
normal
,
compile_fail
,
[''])
test
('
Roles8
',
normal
,
compile_fail
,
[''])
test
('
Roles9
',
normal
,
compile_fail
,
[''])
test
('
Roles10
',
normal
,
compile_fail
,
[''])
test
('
Roles11
',
normal
,
compile_fail
,
[''])
test
('
Roles12
',
extra_clean
(['
Roles12.o-boot
',
'
Roles12.hi-boot
']),
run_command
,
['
$MAKE --no-print-directory -s Roles12
'])
test
('
T1496
',
normal
,
compile_fail
,
[''])
test
('
T4846
',
normal
,
compile_fail
,
[''])
test
('
T7148
',
normal
,
compile_fail
,
[''])
...
...
testsuite/tests/indexed-types/should_compile/T3017.stderr
View file @
1e3ca733
...
...
@@ -4,13 +4,15 @@ TYPE SIGNATURES
forall c t t1. (Num t, Num t1, Coll c, Elem c ~ (t, t1)) => c -> c
TYPE CONSTRUCTORS
Coll :: * -> Constraint
class Coll c@N
class Coll c
Roles: [nominal]
RecFlag NonRecursive
type family Elem c
@N
:: *
type family Elem c :: *
empty :: c insert :: Elem c -> c -> c
ListColl :: * -> *
data ListColl a
@R
data ListColl a
No C type associated
Roles: [representational]
RecFlag NonRecursive, Promotable
= L :: forall a. [a] -> ListColl a Stricts: _
FamilyInstance: none
...
...
testsuite/tests/indexed-types/should_fail/ClosedFam3.stderr
View file @
1e3ca733
...
...
@@ -2,24 +2,24 @@
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
Main module: closed type family Foo a :: * where
Foo Int = Bool
Foo Double = Char
Boot file: closed type family Foo a
@N
:: * where Foo Int = Bool
Boot file: closed type family Foo a :: * 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
Main module: closed type family Bar a :: * where
Bar Int = Bool
Bar Double = Double
Boot file: closed type family Bar a
@N
:: * where
Boot file: closed type family Bar a :: * 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
Main module: closed type family Baz a :: * where Baz Int = Bool
Boot file: closed type family Baz (k::BOX) (a::k) :: * where
Baz * Int = Bool
testsuite/tests/indexed-types/should_fail/Overlap15.hs
View file @
1e3ca733
...
...
@@ -14,3 +14,4 @@ type family F a b c where
foo
::
Proxy
b
->
F
b
[
b
]
Bool
foo
_
=
False
testsuite/tests/polykinds/T7272.hs-boot
View file @
1e3ca733
...
...
@@ -2,4 +2,5 @@
module
T7272
where
class
C
(
a
::
k
)
@
P
type
role
C
phantom
class
C
(
a
::
k
)
testsuite/tests/rename/should_compile/Imp100Aux.hs-boot
View file @
1e3ca733
{-# LANGUAGE RoleAnnotations #-}
module
Imp100Aux
where
data
T1
a
@
P
data
T2
a
@
P
b
@
P
data
T3
a
@
P
b
@
P
c
@
P
data
T4
a
@
P
b
@
P
c
@
P
d
@
P
data
T5
a
@
P
b
@
P
c
@
P
d
@
P
e
@
P
data
T6
a
@
P
data
T7
a
@
P
b
@
P
data
T8
a
@
P
b
@
P
c
@
P
data
T9
a
@
P
b
@
P
c
@
P
d
@
P
data
T10
a
@
P
b
@
P
c
@
P
d
@
P
e
@
P
data
T1
a
data
T2
a
b
data
T3
a
b
c
data
T4
a
b
c
d
data
T5
a
b
c
d
e
data
T6
a
data
T7
a
b
data
T8
a
b
c
data
T9
a
b
c
d
data
T10
a
b
c
d
e
type
role
T1
phantom
type
role
T2
phantom
phantom
type
role
T3
phantom
phantom
phantom
type
role
T4
phantom
phantom
phantom
phantom
type
role
T5
phantom
phantom
phantom
phantom
phantom
type
role
T6
phantom
type
role
T7
phantom
phantom
type
role
T8
phantom
phantom
phantom
type
role
T9
phantom
phantom
phantom
phantom
type
role
T10
phantom
phantom
phantom
phantom
phantom
testsuite/tests/rename/should_compile/Imp10Aux.hs-boot
View file @
1e3ca733
{-# LANGUAGE RoleAnnotations #-}
module
Imp10Aux
where
data
T1
a
@
P
data
T2
a
@
P
b
@
P
data
T3
a
@
P
b
@
P
c
@
P
data
T4
a
@
P
b
@
P
c
@
P
d
@
P
data
T5
a
@
P
b
@
P
c
@
P
d
@
P
e
@
P
data
T6
a
@
P
data
T7
a
@
P
b
@
P
data
T8
a
@
P
b
@
P
c
@
P
data
T9
a
@
P
b
@
P
c
@
P
d
@
P
data
T10
a
@
P
b
@
P
c
@
P
d
@
P
e
@
P
data
T1
a
data
T2
a
b
data
T3
a
b
c
data
T4
a
b
c
d
data
T5
a
b
c
d
e
data
T6
a
data
T7
a
b
data
T8
a
b
c
data
T9
a
b
c
d
data
T10
a
b
c
d
e
type
role
T1
phantom
type
role
T2
phantom
phantom
type
role
T3
phantom
phantom
phantom
type
role
T4
phantom
phantom
phantom
phantom
type
role
T5
phantom
phantom
phantom
phantom
phantom
type
role
T6
phantom
type
role
T7
phantom
phantom
type
role
T8
phantom
phantom
phantom
type
role
T9
phantom
phantom
phantom
phantom
type
role
T10
phantom
phantom
phantom
phantom
phantom
testsuite/tests/rename/should_compile/Imp500Aux.hs-boot
View file @
1e3ca733
{-# LANGUAGE RoleAnnotations #-}
module
Imp500Aux
where
data
T1
a
@
P
data
T2
a
@
P
b
@
P
data
T3
a
@
P
b
@
P
c
@
P
data
T4
a
@
P
b
@
P
c
@
P
d
@
P
data
T5
a
@
P
b
@
P
c
@
P
d
@
P
e
@
P
data
T6
a
@
P
data
T7
a
@
P
b
@
P
data
T8
a
@
P
b
@
P
c
@
P
data
T9
a
@
P
b
@
P
c
@
P
d
@
P
data
T10
a
@
P
b
@
P
c
@
P
d
@
P
e
@
P
data
T1
a
data
T2
a
b
data
T3
a
b
c
data
T4
a
b
c
d
data
T5
a
b
c
d
e
data
T6
a
data
T7
a
b
data
T8
a
b
c
data
T9
a
b
c
d
data
T10
a
b
c
d
e
type
role
T1
phantom
type
role
T2
phantom
phantom
type
role
T3
phantom
phantom
phantom
type
role
T4
phantom
phantom
phantom
phantom
type
role
T5
phantom
phantom
phantom
phantom
phantom
type
role
T6
phantom
type
role
T7
phantom
phantom
type
role
T8
phantom
phantom
phantom
type
role
T9
phantom
phantom
phantom
phantom
type
role
T10
phantom
phantom
phantom
phantom
phantom
testsuite/tests/rename/should_fail/rnfail055.stderr
View file @
1e3ca733
...
...
@@ -6,42 +6,51 @@ RnFail055.hs-boot:1:73: Warning:
-XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language.
RnFail055.hs-boot:4:1:
Identifier ‛f1’ has conflicting definitions in the module and its hs-boot file
Identifier ‛f1’ has conflicting definitions in the module
and its hs-boot file
Main module: f1 :: Int -> Float
Boot file: f1 :: Float -> Int
RnFail055.hs-boot:6:6:
Type constructor ‛S1’ has conflicting definitions in the module and its hs-boot file
Main module: type S1 a@R b@R = (a, b)
Boot file: type S1 a@R b@R c@R = (a, b)
Type constructor ‛S1’ has conflicting definitions in the module
and its hs-boot file
Main module: type S1 a b = (a, b)
Boot file: type S1 a b c = (a, b)
RnFail055.hs-boot:8:6:
Type constructor ‛S2’ has conflicting definitions in the module and its hs-boot file
Main module: type S2 a@P b@R = forall a1. (a1, b)
Boot file: type S2 a@R b@R = forall b1. (a, b1)
Type constructor ‛S2’ has conflicting definitions in the module
and its hs-boot file
Main module: type S2 a b = forall a1. (a1, b)
Boot file: type S2 a b = forall b1. (a, b1)
RnFail055.hs-boot:12:6:
Type constructor ‛T1’ has conflicting definitions in the module and its hs-boot file
Main module: data T1 a@R b@R
Type constructor ‛T1’ has conflicting definitions in the module
and its hs-boot file
Main module: data T1 a b
No C type associated
Roles: [representational, representational]
RecFlag Recursive, Promotable
= T1 :: forall a b. [b] -> [a] -> T1 a b Stricts: _ _
FamilyInstance: none
Boot file: data T1 a
@R b@R
Boot file: data T1 a
b
No C type associated
Roles: [representational, representational]
RecFlag NonRecursive, Promotable
= T1 :: forall a b. [a] -> [b] -> T1 a b Stricts: _ _
FamilyInstance: none
RnFail055.hs-boot:14:16:
Type constructor ‛T2’ has conflicting definitions in the module and its hs-boot file
Main module: data Eq b => T2 a@R b@P
Type constructor ‛T2’ has conflicting definitions in the module
and its hs-boot file
Main module: data Eq b => T2 a b
No C type associated
Roles: [representational, phantom]
RecFlag Recursive, Promotable
= T2 :: forall a b. a -> T2 a b Stricts: _
FamilyInstance: none
Boot file: data Eq a => T2 a
@R b@R
Boot file: data Eq a => T2 a
b
No C type associated
Roles: [representational, representational]
RecFlag NonRecursive, Promotable
= T2 :: forall a b. a -> T2 a b Stricts: _
FamilyInstance: none
...
...
@@ -53,20 +62,24 @@ RnFail055.hs-boot:17:12:
T3' is exported by the hs-boot file, but not exported by the module
RnFail055.hs-boot:21:6:
Type constructor ‛T5’ has conflicting definitions in the module and its hs-boot file
Main module: data T5 a@R
Type constructor ‛T5’ has conflicting definitions in the module
and its hs-boot file
Main module: data T5 a
No C type associated
Roles: [representational]
RecFlag Recursive, Promotable
= T5 :: forall a. a -> T5 a Stricts: _ Fields: field5
FamilyInstance: none
Boot file: data T5 a
@R
Boot file: data T5 a
No C type associated
Roles: [representational]
RecFlag NonRecursive, Promotable
= T5 :: forall a. a -> T5 a Stricts: _
FamilyInstance: none
RnFail055.hs-boot:23:6:
Type constructor ‛T6’ has conflicting definitions in the module and its hs-boot file
Type constructor ‛T6’ has conflicting definitions in the module
and its hs-boot file
Main module: data T6
No C type associated
RecFlag Recursive, Not promotable
...
...
@@ -79,14 +92,17 @@ RnFail055.hs-boot:23:6:
FamilyInstance: none
RnFail055.hs-boot:25:6:
Type constructor ‛T7’ has conflicting definitions in the module and its hs-boot file
Main module: data T7 a@P
Type constructor ‛T7’ has conflicting definitions in the module
and its hs-boot file
Main module: data T7 a
No C type associated
Roles: [phantom]
RecFlag Recursive, Promotable
= T7 :: forall a a1. a1 -> T7 a Stricts: _
FamilyInstance: none
Boot file: data T7 a
@R
Boot file: data T7 a
No C type associated
Roles: [representational]
RecFlag NonRecursive, Promotable
= T7 :: forall a. a -> T7 a Stricts: _
FamilyInstance: none
...
...
@@ -95,15 +111,23 @@ RnFail055.hs-boot:27:22:
RnFail055.m1 is exported by the hs-boot file, but not exported by the module
RnFail055.hs-boot:28:7:
Class ‛C2’ has conflicting definitions in the module and its hs-boot file
Main module: class C2 a@R b@R
Class ‛C2’ has conflicting definitions in the module
and its hs-boot file
Main module: class C2 a b
Roles: [representational, representational]
RecFlag Recursive
m2 :: a -> b m2' :: a -> b
Boot file: class C2 a@R b@R
Boot file: class C2 a b
Roles: [representational, representational]
RecFlag NonRecursive
m2 :: a -> b
RnFail055.hs-boot:29:24:
Class ‛C3’ has conflicting definitions in the module and its hs-boot file
Main module: class (Eq a, Ord a) => C3 a@R RecFlag Recursive
Boot file: class (Ord a, Eq a) => C3 a@R RecFlag NonRecursive
Class ‛C3’ has conflicting definitions in the module
and its hs-boot file
Main module: class (Eq a, Ord a) => C3 a
Roles: [representational]
RecFlag Recursive
Boot file: class (Ord a, Eq a) => C3 a
Roles: [representational]
RecFlag NonRecursive
testsuite/tests/roles/Makefile
0 → 100644
View file @
1e3ca733
TOP
=
../..
include
$(TOP)/mk/boilerplate.mk
include
$(TOP)/mk/test.mk
testsuite/tests/roles/should_compile/Makefile
0 → 100644
View file @
1e3ca733
TOP
=
../../..
include
$(TOP)/mk/boilerplate.mk
include
$(TOP)/mk/test.mk
testsuite/tests/
deriving
/should_compile/Roles1.hs
→
testsuite/tests/
roles
/should_compile/Roles1.hs
View file @
1e3ca733
...
...
@@ -2,12 +2,17 @@
module
Roles1
where
data
T1
a
@
N
=
K1
a
data
T2
a
@
R
=
K2
a
data
T3
(
a
::
k
)
@
P
=
K3
data
T4
(
a
::
*
->
*
)
@
N
b
=
K4
(
a
b
)
data
T1
a
=
K1
a
data
T2
a
=
K2
a
data
T3
(
a
::
k
)
=
K3
data
T4
(
a
::
*
->
*
)
b
=
K4
(
a
b
)
data
T5
a
=
K5
a
data
T6
a
=
K6
data
T7
a
b
=
K7
b
type
role
T1
nominal
type
role
T2
representational
type
role
T3
phantom
type
role
T4
nominal
_
type
role
T5
_
\ No newline at end of file
testsuite/tests/
deriving
/should_compile/Roles1.stderr
→
testsuite/tests/
roles
/should_compile/Roles1.stderr
View file @
1e3ca733
TYPE SIGNATURES
TYPE CONSTRUCTORS
T1 :: * -> *
data T1 a
@N
data T1 a
No C type associated
Roles: [nominal]
RecFlag NonRecursive, Promotable
= K1 :: forall a. a -> T1 a Stricts: _
FamilyInstance: none
T2 :: * -> *
data T2 a
@R
data T2 a
No C type associated
Roles: [representational]
RecFlag NonRecursive, Promotable
= K2 :: forall a. a -> T2 a Stricts: _
FamilyInstance: none
T3 :: forall (k :: BOX). k -> *
data T3 (k::BOX)
@N
(a::k)
@P
data T3 (k::BOX) (a::k)
No C type associated
Roles: [nominal, phantom]
RecFlag NonRecursive, Not promotable
= K3 :: forall (k::BOX) (a::k). T3 k a
FamilyInstance: none
T4 :: (* -> *) -> * -> *
data T4 (a::* -> *)
@N b@N
data T4 (a::* -> *)
b
No C type associated
Roles: [nominal, nominal]
RecFlag NonRecursive, Not promotable
= K4 :: forall (a::* -> *) b. (a b) -> T4 a b Stricts: _
FamilyInstance: none
T5 :: * -> *
data T5 a
@R
data T5 a
No C type associated
Roles: [representational]
RecFlag NonRecursive, Promotable
= K5 :: forall a. a -> T5 a Stricts: _
FamilyInstance: none
T6 :: forall (k :: BOX). k -> *
data T6 (k::BOX)
@N
(a::k)
@P
data T6 (k::BOX) (a::k)
No C type associated
Roles: [nominal, phantom]
RecFlag NonRecursive, Not promotable
= K6 :: forall (k::BOX) (a::k). T6 k a
FamilyInstance: none
T7 :: forall (k :: BOX). k -> * -> *
data T7 (k::BOX)
@N
(a::k)
@P b@R
data T7 (k::BOX) (a::k)
b
No C type associated
Roles: [nominal, phantom, representational]
RecFlag NonRecursive, Not promotable
= K7 :: forall (k::BOX) (a::k) b. b -> T7 k a b Stricts: _
FamilyInstance: none
...
...
Prev
1
2
3
4
Next
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