diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-02-05 15:34:54 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-09 16:22:52 -0500 |
commit | 17a89b1bdc2a30116c0efba71d93314b85358c6a (patch) | |
tree | 31cb335cefcf4d204083e1c155c8da503d21dac7 /testsuite/tests/typecheck | |
parent | be4231782b316754109d339a409ffc05767e883f (diff) | |
download | haskell-17a89b1bdc2a30116c0efba71d93314b85358c6a.tar.gz |
Fix a long standing bug in constraint solving
When combining
Inert: [W] C ty1 ty2
Work item: [D] C ty1 ty2
we were simply discarding the Derived one. Not good! We should turn
the inert back into [WD] or keep both. E.g. fundeps work only on
Derived (see isImprovable).
This little patch fixes it. The bug is hard to tickle, but #19315 did so.
The fix is a little messy (see Note [KeepBoth] plus the change in
addDictCt), but I am disinclined to refine it further because it'll
all be swept away when we Kill Deriveds.
Diffstat (limited to 'testsuite/tests/typecheck')
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T19315.hs | 42 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 1 |
2 files changed, 43 insertions, 0 deletions
diff --git a/testsuite/tests/typecheck/should_compile/T19315.hs b/testsuite/tests/typecheck/should_compile/T19315.hs new file mode 100644 index 0000000000..d93f42c4d4 --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T19315.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +module Bug where + +import Control.Monad.Reader +import Data.Kind + +type Lens f s a = (f, s, a) + +view :: MonadReader s m => Lens a s a -> m a +view = undefined + +data TickLabels b n = TickLabels + +type family N a :: Type +type instance N (TickLabels b n) = n + +tickLabelTextFunction :: Lens f a (QDiagram b (N a)) +tickLabelTextFunction = undefined + +class HasTickLabels f a b | a -> b where + tickLabelFunction :: Lens f a (N a -> String) + +instance HasTickLabels f (TickLabels b n) b where + tickLabelFunction = undefined + +data QDiagram b n = QD + +renderColourBar :: forall n b. TickLabels b n -> n -> () +renderColourBar cbTickLabels bnds = () + where + f :: a -> a + f x = x + + tickLabelXs :: String + tickLabelXs = view tickLabelFunction cbTickLabels bnds + + drawTickLabel :: n -> QDiagram b n + drawTickLabel x = view tickLabelTextFunction cbTickLabels + where v = f x diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 3842a1984c..46f2d088d1 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -770,3 +770,4 @@ test('InlinePatSyn_ExplicitBidiBuilder', [], makefile_test, []) test('InlinePatSyn_ExplicitBidiMatcher', [], makefile_test, []) test('T18467', normal, compile, ['']) +test('T19315', normal, compile, ['']) |