Skip to content

Commit 0cf3417

Browse files
soulomoonMarge Bot
authored andcommitted
Family consistency checks: add test for #26154
This commit adds the test T26154, to make sure that GHC doesn't crash when performing type family consistency checks. This test case was extracted from Agda. Fixes #26154
1 parent 0975d2b commit 0cf3417

File tree

6 files changed

+34
-0
lines changed

6 files changed

+34
-0
lines changed
Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
2+
module T26154 where
3+
4+
import {-# SOURCE #-} T26154_B
5+
import T26154_Other
Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
2+
{-# LANGUAGE TypeFamilies #-}
3+
4+
module T26154_A where
5+
6+
import {-# SOURCE #-} T26154_B
7+
8+
type family F a b
9+
type instance F a b = b
Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
{-# LANGUAGE TypeFamilies #-}
2+
3+
module T26154_B where
4+
5+
import T26154_A
6+
7+
type family FAA a b
8+
9+
type instance FAA a b = b
Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
{-# LANGUAGE TypeFamilies #-}
2+
3+
module T26154_B where
Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
{-# LANGUAGE TypeFamilies #-}
2+
3+
module T26154_Other where
4+
5+
type family OtherF a b
6+
7+
type instance OtherF a b = b

testsuite/tests/typecheck/should_compile/all.T

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -947,6 +947,7 @@ test('T25992', normal, compile, [''])
947947
test('T14010', normal, compile, [''])
948948
test('T26256a', normal, compile, [''])
949949
test('T25992a', normal, compile, [''])
950+
test('T26154', [extra_files(['T26154_A.hs', 'T26154_B.hs', 'T26154_B.hs-boot', 'T26154_Other.hs'])], multimod_compile, ['T26154', '-v0'])
950951
test('T26346', normal, compile, [''])
951952
test('T26358', expect_broken(26358), compile, [''])
952953
test('T26345', normal, compile, [''])

0 commit comments

Comments
 (0)