Skip to content

Commit

Permalink
Add test for T5863
Browse files Browse the repository at this point in the history
As apparently there is already a test named T5863,
I named this one T5863a.
  • Loading branch information
dreixel committed May 21, 2013
1 parent e5c5252 commit 48e8390
Show file tree
Hide file tree
Showing 3 changed files with 25 additions and 0 deletions.
12 changes: 12 additions & 0 deletions tests/deriving/should_fail/T5863a.hs
@@ -0,0 +1,12 @@
{-# LANGUAGE DeriveDataTypeable, TypeFamilies #-}

import Data.Typeable

class C a where
data T a :: *

instance C Int where
data T Int = A1 deriving (Typeable)

instance C Bool where
data T Bool = A2 deriving (Typeable)
12 changes: 12 additions & 0 deletions tests/deriving/should_fail/T5863a.stderr
@@ -0,0 +1,12 @@

T5863a.hs:9:31:
Can't make a derived instance of ‛Typeable * (T Int)’:
Deriving Typeable is not allowed for family instances;
derive Typeable for ‛T’ alone
In the data instance declaration for ‛T’

T5863a.hs:12:32:
Can't make a derived instance of ‛Typeable * (T Bool)’:
Deriving Typeable is not allowed for family instances;
derive Typeable for ‛T’ alone
In the data instance declaration for ‛T’
1 change: 1 addition & 0 deletions tests/deriving/should_fail/all.T
Expand Up @@ -39,3 +39,4 @@ test('T1133A',
extra_clean(['T1133A.o-boot', 'T1133A.hi-boot']),
run_command,
['$MAKE --no-print-directory -s T1133A'])
test('T5863a', normal, compile_fail, [''])

0 comments on commit 48e8390

Please sign in to comment.