diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-02-11 14:44:20 +0000 |
---|---|---|
committer | Ben Gamari <ben@smart-cactus.org> | 2021-02-19 11:03:46 -0500 |
commit | 4196969c53c55191e644d9eb258c14c2bc8467da (patch) | |
tree | bb4608ff96e916c204b6837405690190b70c59db /testsuite/tests | |
parent | f78f001c91736e31cdfb23959647226f9bd9fe6b (diff) | |
download | haskell-4196969c53c55191e644d9eb258c14c2bc8467da.tar.gz |
Improve handling of overloaded labels, literals, lists etcwip/T19154
When implementing Quick Look I'd failed to remember that overloaded
labels, like #foo, should be treated as a "head", so that they can be
instantiated with Visible Type Application. This caused #19154.
A very similar ticket covers overloaded literals: #19167.
This patch fixes both problems, but (annoyingly, albeit temporarily)
in two different ways.
Overloaded labels
I dealt with overloaded labels by buying fully into the
Rebindable Syntax approach described in GHC.Hs.Expr
Note [Rebindable syntax and HsExpansion].
There is a good overview in GHC.Rename.Expr
Note [Handling overloaded and rebindable constructs].
That module contains much of the payload for this patch.
Specifically:
* Overloaded labels are expanded in the renamer, fixing #19154.
See Note [Overloaded labels] in GHC.Rename.Expr.
* Left and right sections used to have special code paths in the
typechecker and desugarer. Now we just expand them in the
renamer. This is harder than it sounds. See GHC.Rename.Expr
Note [Left and right sections].
* Infix operator applications are expanded in the typechecker,
specifically in GHC.Tc.Gen.App.splitHsApps. See
Note [Desugar OpApp in the typechecker] in that module
* ExplicitLists are expanded in the renamer, when (and only when)
OverloadedLists is on.
* HsIf is expanded in the renamer when (and only when) RebindableSyntax
is on. Reason: the coverage checker treats HsIf specially. Maybe
we could instead expand it unconditionally, and fix up the coverage
checker, but I did not attempt that.
Overloaded literals
Overloaded literals, like numbers (3, 4.2) and strings with
OverloadedStrings, were not working correctly with explicit type
applications (see #19167). Ideally I'd also expand them in the
renamer, like the stuff above, but I drew back on that because they
can occur in HsPat as well, and I did not want to to do the HsExpanded
thing for patterns.
But they *can* now be the "head" of an application in the typechecker,
and hence something like ("foo" @T) works now. See
GHC.Tc.Gen.Head.tcInferOverLit. It's also done a bit more elegantly,
rather than by constructing a new HsExpr and re-invoking the
typechecker. There is some refactoring around tcShortCutLit.
Ultimately there is more to do here, following the Rebindable Syntax
story.
There are a lot of knock-on effects:
* HsOverLabel and ExplicitList no longer need funny (Maybe SyntaxExpr)
fields to support rebindable syntax -- good!
* HsOverLabel, OpApp, SectionL, SectionR all become impossible in the
output of the typecheker, GhcTc; so we set their extension fields to
Void. See GHC.Hs.Expr Note [Constructor cannot occur]
* Template Haskell quotes for HsExpanded is a bit tricky. See
Note [Quotation and rebindable syntax] in GHC.HsToCore.Quote.
* In GHC.HsToCore.Match.viewLExprEq, which groups equal HsExprs for the
purpose of pattern-match overlap checking, I found that dictionary
evidence for the same type could have two different names. Easily
fixed by comparing types not names.
* I did quite a bit of annoying fiddling around in GHC.Tc.Gen.Head and
GHC.Tc.Gen.App to get error message locations and contexts right,
esp in splitHsApps, and the HsExprArg type. Tiresome and not very
illuminating. But at least the tricky, higher order, Rebuilder
function is gone.
* Some refactoring in GHC.Tc.Utils.Monad around contexts and locations
for rebindable syntax.
* Incidentally fixes #19346, because we now print renamed, rather than
typechecked, syntax in error mesages about applications.
The commit removes the vestigial module GHC.Builtin.RebindableNames,
and thus triggers a 2.4% metric decrease for test MultiLayerModules
(#19293).
Metric Decrease:
MultiLayerModules
T12545
Diffstat (limited to 'testsuite/tests')
27 files changed, 140 insertions, 53 deletions
diff --git a/testsuite/tests/annotations/should_fail/annfail10.stderr b/testsuite/tests/annotations/should_fail/annfail10.stderr index fe0ff42a3e..a6e767f9e5 100644 --- a/testsuite/tests/annotations/should_fail/annfail10.stderr +++ b/testsuite/tests/annotations/should_fail/annfail10.stderr @@ -1,8 +1,8 @@ annfail10.hs:9:1: error: - • Ambiguous type variable ‘p0’ arising from an annotation - prevents the constraint ‘(Data.Data.Data p0)’ from being solved. - Probable fix: use a type annotation to specify what ‘p0’ should be. + • Ambiguous type variable ‘a0’ arising from an annotation + prevents the constraint ‘(Data.Data.Data a0)’ from being solved. + Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance (Data.Data.Data a, Data.Data.Data b) => Data.Data.Data (Either a b) @@ -16,9 +16,9 @@ annfail10.hs:9:1: error: • In the annotation: {-# ANN f 1 #-} annfail10.hs:9:11: error: - • Ambiguous type variable ‘p0’ arising from the literal ‘1’ - prevents the constraint ‘(Num p0)’ from being solved. - Probable fix: use a type annotation to specify what ‘p0’ should be. + • Ambiguous type variable ‘a0’ arising from the literal ‘1’ + prevents the constraint ‘(Num a0)’ from being solved. + Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance Num Integer -- Defined in ‘GHC.Num’ instance Num Double -- Defined in ‘GHC.Float’ diff --git a/testsuite/tests/ghci.debugger/Test3.hs b/testsuite/tests/ghci.debugger/Test3.hs index 3bb7bd629b..fc66e943da 100644 --- a/testsuite/tests/ghci.debugger/Test3.hs +++ b/testsuite/tests/ghci.debugger/Test3.hs @@ -1,4 +1,4 @@ mymap f [] = [] mymap f (x:xs) = f x:mymap f xs -main = mapM_ putStrLn $ mymap ('a':) ["hello","bye"] +main = mapM_ putStrLn $ mymap ('a':) ["hello","bye"] diff --git a/testsuite/tests/ghci.debugger/scripts/break017.script b/testsuite/tests/ghci.debugger/scripts/break017.script index 8873b1a0d8..d598a474d7 100644 --- a/testsuite/tests/ghci.debugger/scripts/break017.script +++ b/testsuite/tests/ghci.debugger/scripts/break017.script @@ -1,11 +1,17 @@ :l QSort.hs :set -fbreak-on-exception :trace qsort ("abc" ++ undefined) + +-- Back up to the (filter (<=a) as) call :back +:back + putStrLn "Printing 1" :print as + putStrLn "Forcing" :force as + -- this should print the exception putStrLn "Printing 2" :print as diff --git a/testsuite/tests/ghci.debugger/scripts/break017.stdout b/testsuite/tests/ghci.debugger/scripts/break017.stdout index 0de6e662ac..af22c066e6 100644 --- a/testsuite/tests/ghci.debugger/scripts/break017.stdout +++ b/testsuite/tests/ghci.debugger/scripts/break017.stdout @@ -1,5 +1,8 @@ "Stopped in <exception thrown>, <unknown> _exception :: e = _ +Logged breakpoint at QSort.hs:6:32-34 +_result :: Char -> Bool +a :: Char Logged breakpoint at QSort.hs:6:24-38 _result :: [Char] a :: Char @@ -9,7 +12,7 @@ as = 'b' : 'c' : (_t1::[Char]) Forcing *** Exception: Prelude.undefined CallStack (from HasCallStack): - error, called at libraries/base/GHC/Err.hs:79:14 in base:GHC.Err + error, called at libraries/base/GHC/Err.hs:75:14 in base:GHC.Err undefined, called at <interactive>:3:17 in interactive:Ghci1 Printing 2 as = 'b' : 'c' : (_t2::[Char]) diff --git a/testsuite/tests/ghci.debugger/scripts/listCommand001.stdout b/testsuite/tests/ghci.debugger/scripts/listCommand001.stdout index 956ae6a97a..5aeb38bcd6 100644 --- a/testsuite/tests/ghci.debugger/scripts/listCommand001.stdout +++ b/testsuite/tests/ghci.debugger/scripts/listCommand001.stdout @@ -5,10 +5,10 @@ cannot list source code for map: module GHC.Base is not interpreted 1 mymap f [] = [] 2 mymap f (x:xs) = f x:mymap f xs 3 -4 main = mapM_ putStrLn $ mymap ('a':) ["hello","bye"] +4 main = mapM_ putStrLn $ mymap ('a':) ["hello","bye"] 5 3 -4 main = mapM_ putStrLn $ mymap ('a':) ["hello","bye"] +4 main = mapM_ putStrLn $ mymap ('a':) ["hello","bye"] 5 syntax: :list [<line> | <module> <line> | <identifier>] syntax: :list [<line> | <module> <line> | <identifier>] diff --git a/testsuite/tests/indexed-types/should_fail/T5439.stderr b/testsuite/tests/indexed-types/should_fail/T5439.stderr index c7f230654e..5dcce91edb 100644 --- a/testsuite/tests/indexed-types/should_fail/T5439.stderr +++ b/testsuite/tests/indexed-types/should_fail/T5439.stderr @@ -3,8 +3,7 @@ T5439.hs:82:33: error: • Couldn't match expected type: Attempt (HElemOf rs) with actual type: Attempt (HHead (HDrop n0 l0)) -> Attempt (HElemOf l0) - • Probable cause: ‘($)’ is applied to too few arguments - In the second argument of ‘($)’, namely + • In the second argument of ‘($)’, namely ‘inj $ Failure (e :: SomeException)’ In a stmt of a 'do' block: c <- complete ev $ inj $ Failure (e :: SomeException) diff --git a/testsuite/tests/indexed-types/should_fail/T7354.stderr b/testsuite/tests/indexed-types/should_fail/T7354.stderr index f8ebc7d923..e2dfbedf28 100644 --- a/testsuite/tests/indexed-types/should_fail/T7354.stderr +++ b/testsuite/tests/indexed-types/should_fail/T7354.stderr @@ -1,13 +1,13 @@ T7354.hs:28:11: error: - • Couldn't match type ‘p’ with ‘Base t (Prim [p] p)’ - Expected: Prim [p] p -> Base t (Prim [p] p) - Actual: Prim [p] p -> p - ‘p’ is a rigid type variable bound by - the inferred type of foo :: Prim [p] p -> t + • Couldn't match type ‘a’ with ‘Base t (Prim [a] a)’ + Expected: Prim [a] a -> Base t (Prim [a] a) + Actual: Prim [a] a -> a + ‘a’ is a rigid type variable bound by + the inferred type of foo :: Prim [a] a -> t at T7354.hs:28:1-13 • In the first argument of ‘ana’, namely ‘alg’ In the expression: ana alg In an equation for ‘foo’: foo = ana alg • Relevant bindings include - foo :: Prim [p] p -> t (bound at T7354.hs:28:1) + foo :: Prim [a] a -> t (bound at T7354.hs:28:1) diff --git a/testsuite/tests/linear/should_compile/OldList.hs b/testsuite/tests/linear/should_compile/OldList.hs index e84b5bb927..d0945a7a07 100644 --- a/testsuite/tests/linear/should_compile/OldList.hs +++ b/testsuite/tests/linear/should_compile/OldList.hs @@ -32,3 +32,5 @@ sortBy cmp = [] foo ys = as (a:ys) ascending a as bs = let !x = as [a] in x : sequences bs + + diff --git a/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.stdout b/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.stdout index ad4352ef10..e6d8167be8 100644 --- a/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.stdout +++ b/testsuite/tests/overloadedrecflds/ghci/overloadedlabelsghci01.stdout @@ -1,4 +1,4 @@ -#x :: GHC.OverloadedLabels.IsLabel "x" t => t +#x :: GHC.OverloadedLabels.IsLabel "x" a => a "hello" "hello world" "goodbye world" diff --git a/testsuite/tests/overloadedrecflds/should_compile/T19154.hs b/testsuite/tests/overloadedrecflds/should_compile/T19154.hs new file mode 100644 index 0000000000..03deb7d44f --- /dev/null +++ b/testsuite/tests/overloadedrecflds/should_compile/T19154.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +module Labels where + +-- base +import Prelude +import Data.Kind + ( Type ) +import GHC.TypeLits + ( Symbol, KnownSymbol ) + +-------------------------------------------------------------------------- + +data Label (k :: Symbol) (a :: Type) = Label + +class IsLabel k a v | v -> a, v -> k where + fromLabel :: v + +-- fromLabel :: forall {k1} {k2} (k3 :: k1) (a :: k2) v. +-- IsLabel {k1} {k2} k3 a v => v + +instance KnownSymbol k => IsLabel k a (Label k a) where + fromLabel = Label @k @a + +foo :: Label k a -> () +foo _ = () + +test :: () +test = foo (#label @Bool) + diff --git a/testsuite/tests/overloadedrecflds/should_compile/all.T b/testsuite/tests/overloadedrecflds/should_compile/all.T index a043570034..b52c43a655 100644 --- a/testsuite/tests/overloadedrecflds/should_compile/all.T +++ b/testsuite/tests/overloadedrecflds/should_compile/all.T @@ -8,3 +8,5 @@ test('NFSDRF', normal, compile, ['']) test('NFSImport', [extra_files(['NFSExport.hs'])], multimod_compile, ['NFSImport NFSExport', '-v0']) test('T18999_NoFieldSelectors', normal, compile, ['']) test('T18999_FieldSelectors', normal, compile, ['']) +test('T19154', normal, compile, ['']) + diff --git a/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr b/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr index 44bc014f84..f88875408d 100644 --- a/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr +++ b/testsuite/tests/overloadedrecflds/should_fail/overloadedlabelsfail01.stderr @@ -1,6 +1,6 @@ overloadedlabelsfail01.hs:6:5: error: - • No instance for (IsLabel "x" t0) + • No instance for (IsLabel "x" a0) arising from the overloaded label ‘#x’ • In the expression: #x In an equation for ‘a’: a = #x diff --git a/testsuite/tests/parser/should_compile/T2245.stderr b/testsuite/tests/parser/should_compile/T2245.stderr index 8e48cfb189..ca38eec5ac 100644 --- a/testsuite/tests/parser/should_compile/T2245.stderr +++ b/testsuite/tests/parser/should_compile/T2245.stderr @@ -17,6 +17,6 @@ T2245.hs:7:27: warning: [-Wtype-defaults (in -Wall)] (Fractional b0) arising from the literal ‘1e400’ at T2245.hs:7:29-33 (Read b0) arising from a use of ‘read’ at T2245.hs:7:38-41 - • In the first argument of ‘(.)’, namely ‘(< 1e400)’ + • In the expression: (<) + In the first argument of ‘(.)’, namely ‘(< 1e400)’ In the second argument of ‘(.)’, namely ‘(< 1e400) . read’ - In the second argument of ‘($)’, namely ‘show . (< 1e400) . read’ diff --git a/testsuite/tests/parser/should_compile/T515.stderr b/testsuite/tests/parser/should_compile/T515.stderr index dde5d47b0e..580b8e722a 100644 --- a/testsuite/tests/parser/should_compile/T515.stderr +++ b/testsuite/tests/parser/should_compile/T515.stderr @@ -3,16 +3,16 @@ T515.lhs:6:3: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: a :: Integer T515.lhs:6:7: warning: [-Wtype-defaults (in -Wall)] - Defaulting the following constraint to type ‘Integer’ - Num p0 arising from the literal ‘1’ - In the expression: 1 + • Defaulting the following constraint to type ‘Integer’ + Num a0 arising from the literal ‘1’ + • In the expression: 1 In an equation for ‘a’: a = 1 T515.lhs:7:3: warning: [-Wmissing-signatures (in -Wall)] Top-level binding with no type signature: b :: Integer T515.lhs:7:7: warning: [-Wtype-defaults (in -Wall)] - Defaulting the following constraint to type ‘Integer’ - Num p0 arising from the literal ‘2’ - In the expression: 2 + • Defaulting the following constraint to type ‘Integer’ + Num a0 arising from the literal ‘2’ + • In the expression: 2 In an equation for ‘b’: b = 2 diff --git a/testsuite/tests/rebindable/T19167.hs b/testsuite/tests/rebindable/T19167.hs new file mode 100644 index 0000000000..6f7ebff33d --- /dev/null +++ b/testsuite/tests/rebindable/T19167.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE RebindableSyntax, RankNTypes, TypeApplications, OverloadedStrings, + OverloadedLists, TypeFamilies #-} + +module Bug where + +import qualified Prelude as P +import qualified GHC.Exts as P +import Data.List.NonEmpty ( NonEmpty ) + +fromInteger :: P.Integer -> forall a. P.Num a => a +fromInteger n = P.fromInteger n + +shouldBeAnInt = 3 @P.Int + +newtype RevString = RevString P.String + deriving P.Show + +instance P.IsString RevString where + fromString str = RevString (P.reverse str) + +fromString :: P.String -> forall a. P.IsString a => a +fromString str = P.fromString str + +shouldBeARevString = "hello" @RevString + +fromListN :: P.Int -> [elt] -> forall list. (P.IsList list, elt ~ P.Item list) => list +fromListN n l = P.fromListN n l + +shouldBeANonEmpty = ['x', 'y', 'z'] @(NonEmpty P.Char) diff --git a/testsuite/tests/rebindable/all.T b/testsuite/tests/rebindable/all.T index 49f77d607e..c58efa5db0 100644 --- a/testsuite/tests/rebindable/all.T +++ b/testsuite/tests/rebindable/all.T @@ -39,3 +39,4 @@ test('T11216', normal, compile, ['']) test('T11216A', normal, compile, ['']) test('T12080', normal, compile, ['']) test('T14670', expect_broken(14670), compile, ['']) +test('T19167', normal, compile, ['']) diff --git a/testsuite/tests/th/T16976.stderr b/testsuite/tests/th/T16976.stderr index 19584153c0..9cad331b51 100644 --- a/testsuite/tests/th/T16976.stderr +++ b/testsuite/tests/th/T16976.stderr @@ -1,4 +1,4 @@ -T16976.aNumber :: forall {p_0 :: *} . GHC.Num.Num p_0 => p_0 +T16976.aNumber :: forall {a_0 :: *} . GHC.Num.Num a_0 => a_0 T16976.aString :: GHC.Base.String T16976.MkT1 :: forall (s_0 :: *) . T16976.T s_0 T16976.MkT2 :: forall (s_0 :: *) . T16976.T s_0 diff --git a/testsuite/tests/typecheck/should_compile/T14590.stderr b/testsuite/tests/typecheck/should_compile/T14590.stderr index 7ecfa761f1..6f0ab068bc 100644 --- a/testsuite/tests/typecheck/should_compile/T14590.stderr +++ b/testsuite/tests/typecheck/should_compile/T14590.stderr @@ -1,8 +1,7 @@ T14590.hs:4:13: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int -> Int -> Int - • In the expression: x `_` - In the expression: (x `_`) y + • In the expression: (x `_`) y In an equation for ‘f1’: f1 x y = (x `_`) y • Relevant bindings include y :: Int (bound at T14590.hs:4:6) @@ -89,8 +88,7 @@ T14590.hs:4:13: warning: [-Wtyped-holes (in -Wdefault)] T14590.hs:5:13: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _a :: Int -> Int -> Int Or perhaps ‘_a’ is mis-spelled, or not in scope - • In the expression: x `_a` - In the expression: (x `_a`) y + • In the expression: (x `_a`) y In an equation for ‘f2’: f2 x y = (x `_a`) y • Relevant bindings include y :: Int (bound at T14590.hs:5:6) @@ -176,8 +174,7 @@ T14590.hs:5:13: warning: [-Wtyped-holes (in -Wdefault)] T14590.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _ :: Int -> Int -> Int - • In the expression: `_` x - In the expression: (`_` x) y + • In the expression: (`_` x) y In an equation for ‘f3’: f3 x y = (`_` x) y • Relevant bindings include y :: Int (bound at T14590.hs:6:6) @@ -264,8 +261,7 @@ T14590.hs:6:11: warning: [-Wtyped-holes (in -Wdefault)] T14590.hs:7:11: warning: [-Wtyped-holes (in -Wdefault)] • Found hole: _a :: Int -> Int -> Int Or perhaps ‘_a’ is mis-spelled, or not in scope - • In the expression: `_a` x - In the expression: (`_a` x) y + • In the expression: (`_a` x) y In an equation for ‘f4’: f4 x y = (`_a` x) y • Relevant bindings include y :: Int (bound at T14590.hs:7:6) diff --git a/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr index e631106dd0..4214016b2a 100644 --- a/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr +++ b/testsuite/tests/typecheck/should_compile/T17775-viewpats-b.stderr @@ -5,6 +5,6 @@ T17775-viewpats-b.hs:7:9: error: add (Eq a) to the context of the type signature for: ex2 :: forall a. a -> a -> Int -> Eq a => Bool - • In the expression: == x + • In the expression: (==) + In the expression: == x In the pattern: (== x) -> result - In an equation for ‘ex2’: ex2 x ((== x) -> result) = \ _ -> result diff --git a/testsuite/tests/typecheck/should_fail/T12921.stderr b/testsuite/tests/typecheck/should_fail/T12921.stderr index 7dd612348d..478d2f03c8 100644 --- a/testsuite/tests/typecheck/should_fail/T12921.stderr +++ b/testsuite/tests/typecheck/should_fail/T12921.stderr @@ -1,8 +1,8 @@ T12921.hs:4:1: error: - • Ambiguous type variable ‘p0’ arising from an annotation - prevents the constraint ‘(Data.Data.Data p0)’ from being solved. - Probable fix: use a type annotation to specify what ‘p0’ should be. + • Ambiguous type variable ‘a0’ arising from an annotation + prevents the constraint ‘(Data.Data.Data a0)’ from being solved. + Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance (Data.Data.Data a, Data.Data.Data b) => Data.Data.Data (Either a b) @@ -17,10 +17,10 @@ T12921.hs:4:1: error: {-# ANN module "HLint: ignore Reduce duplication" #-} T12921.hs:4:16: error: - • Ambiguous type variable ‘p0’ arising from the literal ‘"HLint: ignore Reduce duplication"’ + • Ambiguous type variable ‘a0’ arising from the literal ‘"HLint: ignore Reduce duplication"’ prevents the constraint ‘(Data.String.IsString - p0)’ from being solved. - Probable fix: use a type annotation to specify what ‘p0’ should be. + a0)’ from being solved. + Probable fix: use a type annotation to specify what ‘a0’ should be. These potential instances exist: instance (a ~ Char) => Data.String.IsString [a] -- Defined in ‘Data.String’ diff --git a/testsuite/tests/typecheck/should_fail/T19346.hs b/testsuite/tests/typecheck/should_fail/T19346.hs new file mode 100644 index 0000000000..c2e7ea4722 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T19346.hs @@ -0,0 +1,9 @@ +module T19346 where + +data T = MkT Int + +f :: Bool -> T +f x = MkT x + +-- Produced a bad error message when compiled with +-- -fprint-typechecker-elaboration diff --git a/testsuite/tests/typecheck/should_fail/T19346.stderr b/testsuite/tests/typecheck/should_fail/T19346.stderr new file mode 100644 index 0000000000..d9cb0632e9 --- /dev/null +++ b/testsuite/tests/typecheck/should_fail/T19346.stderr @@ -0,0 +1,6 @@ + +T19346.hs:6:11: error: + • Couldn't match expected type ‘Int’ with actual type ‘Bool’ + • In the first argument of ‘MkT’, namely ‘x’ + In the expression: MkT x + In an equation for ‘f’: f x = MkT x diff --git a/testsuite/tests/typecheck/should_fail/T6069.stderr b/testsuite/tests/typecheck/should_fail/T6069.stderr index ffad9a9534..98b0587bbc 100644 --- a/testsuite/tests/typecheck/should_fail/T6069.stderr +++ b/testsuite/tests/typecheck/should_fail/T6069.stderr @@ -24,4 +24,4 @@ T6069.hs:15:16: error: Actual: (forall s. ST s b2) -> b2 • In the second argument of ‘(.)’, namely ‘runST’ In the first argument of ‘($)’, namely ‘(print . runST)’ - In the expression: (print . runST) $ + In the expression: ((print . runST) $) fourty_two diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T index 052bdd9201..07eafc65b5 100644 --- a/testsuite/tests/typecheck/should_fail/all.T +++ b/testsuite/tests/typecheck/should_fail/all.T @@ -615,3 +615,4 @@ test('TyAppPat_TooMany', normal, compile_fail, ['']) test('T12178a', normal, compile_fail, ['']) test('T18869', normal, compile_fail, ['']) test('T19142', normal, compile_fail, ['']) +test('T19346', normal, compile_fail, ['-fprint-typechecker-elaboration']) diff --git a/testsuite/tests/typecheck/should_fail/tcfail013.stderr b/testsuite/tests/typecheck/should_fail/tcfail013.stderr index 3803d9ce95..e870b18ced 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail013.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail013.stderr @@ -4,4 +4,4 @@ tcfail013.hs:4:3: error: • In the pattern: True In an equation for ‘f’: f True = 2 • Relevant bindings include - f :: [a] -> p (bound at tcfail013.hs:3:1) + f :: [a] -> a1 (bound at tcfail013.hs:3:1) diff --git a/testsuite/tests/typecheck/should_fail/tcfail140.hs b/testsuite/tests/typecheck/should_fail/tcfail140.hs index 1fb82bb119..8a4bb7dbe5 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail140.hs +++ b/testsuite/tests/typecheck/should_fail/tcfail140.hs @@ -17,6 +17,3 @@ t = ((\Just x -> x) :: Maybe a -> a) (Just 1) g :: Int -> Int g x y = True - - - diff --git a/testsuite/tests/typecheck/should_fail/tcfail140.stderr b/testsuite/tests/typecheck/should_fail/tcfail140.stderr index 4e1ced2fc9..8bce6238c6 100644 --- a/testsuite/tests/typecheck/should_fail/tcfail140.stderr +++ b/testsuite/tests/typecheck/should_fail/tcfail140.stderr @@ -18,10 +18,9 @@ tcfail140.hs:12:10: error: tcfail140.hs:14:15: error: • Couldn't match expected type ‘a -> b’ with actual type ‘Int’ - • The operator ‘f’ takes two value arguments, - but its type ‘Int -> Int’ has only one - In the first argument of ‘map’, namely ‘(3 `f`)’ + • In the first argument of ‘map’, namely ‘(3 `f`)’ In the expression: map (3 `f`) xs + In an equation for ‘bot’: bot xs = map (3 `f`) xs • Relevant bindings include xs :: [a] (bound at tcfail140.hs:14:5) bot :: [a] -> [b] (bound at tcfail140.hs:14:1) |