summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2022-05-16 18:22:40 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-05-17 07:18:26 -0400
commit2343457df2509447ed869bc251897fc0286591bc (patch)
tree30348bcbce66c406826fa922ab75c96f2267f885
parent70f52443550d37985cf7e06ffafd5a162319d9e1 (diff)
downloadhaskell-2343457df2509447ed869bc251897fc0286591bc.tar.gz
Remove unused test files (#21582)
Those files were moved to the perf/ subtree in 11c9a469, and then accidentally reintroduced in 680ef2c8.
-rw-r--r--testsuite/tests/typecheck/should_compile/T16875.hs13
-rw-r--r--testsuite/tests/typecheck/should_compile/T16875.stderr12
-rw-r--r--testsuite/tests/typecheck/should_compile/hard_hole_fits.hs47
-rw-r--r--testsuite/tests/typecheck/should_compile/hard_hole_fits.stderr679
4 files changed, 0 insertions, 751 deletions
diff --git a/testsuite/tests/typecheck/should_compile/T16875.hs b/testsuite/tests/typecheck/should_compile/T16875.hs
deleted file mode 100644
index 0ba3c17d5b..0000000000
--- a/testsuite/tests/typecheck/should_compile/T16875.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module T16875 where
-
-import Control.Applicative
-import Control.Monad
-import Data.Kind
-import Data.List
-import Data.Maybe
-import Data.String
-import GHC.Exts
-import GHC.Types
-
-a = _
-
diff --git a/testsuite/tests/typecheck/should_compile/T16875.stderr b/testsuite/tests/typecheck/should_compile/T16875.stderr
deleted file mode 100644
index af6954792e..0000000000
--- a/testsuite/tests/typecheck/should_compile/T16875.stderr
+++ /dev/null
@@ -1,12 +0,0 @@
-
-T16875.hs:12:5: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: p
- Where: ‘p’ is a rigid type variable bound by
- the inferred type of a :: p
- at T16875.hs:12:1-5
- • In an equation for ‘a’: a = _
- • Relevant bindings include a :: p (bound at T16875.hs:12:1)
- Valid hole fits include
- a :: forall {p}. p
- with a
- (defined at T16875.hs:12:1)
diff --git a/testsuite/tests/typecheck/should_compile/hard_hole_fits.hs b/testsuite/tests/typecheck/should_compile/hard_hole_fits.hs
deleted file mode 100644
index b74aeb4eae..0000000000
--- a/testsuite/tests/typecheck/should_compile/hard_hole_fits.hs
+++ /dev/null
@@ -1,47 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
--- typechecking goes really fast if you uncomment this line
-
--- {-# OPTIONS_GHC -fmax-valid-hole-fits=0 #-}
-
-module SlowTypecheck where
-
-import Language.Haskell.Syntax.Expr
-import GHC (GhcPs)
-
-testMe :: HsExpr GhcPs -> Int
-testMe (HsVar a b) = _
-testMe (HsUnboundVar xuv uv) = _
-testMe (HsOverLabel xol m_ip) = _
-testMe (HsIPVar xv hin) = _
-testMe (HsOverLit xole hol) = _
-testMe (HsLit xle hl) = _
-testMe (HsLam xl mg) = _
-testMe (HsLamCase xlc lc_variant mg) = _
-testMe (HsApp xa gl gl') = _
-testMe (HsAppType xate gl hwcb) = _
-testMe (OpApp xoa gl gl' gl2) = _
-testMe (NegApp xna gl se) = _
-testMe (HsPar xp gl ab ac) = _
-testMe (SectionL xsl gl gl') = _
-testMe (SectionR xsr gl gl') = _
-testMe (ExplicitTuple xet gls box) = _
-testMe (ExplicitSum xes n i gl) = _
-testMe (HsCase xc gl mg) = _
-testMe (HsIf xi m_se gl gl' ) = _
-testMe (HsMultiIf xmi gls) = _
-testMe (HsLet xl tkLet gl tkIn gl') = _
-testMe (HsDo xd hsc gl) = _
-testMe (ExplicitList xel m_se) = _
-testMe (RecordCon xrc gl hrf) = _
-testMe (RecordUpd xru gl gls) = _
-testMe (ExprWithTySig xewts gl hwcb) = _
-testMe (ArithSeq xas m_se asi) = _
-testMe (HsBracket xb hb) = _
-testMe (HsRnBracketOut xrbo hb prss) = _
-testMe (HsTcBracketOut xtbo hb ptss as) = _
-testMe (HsSpliceE xse hs) = _
-testMe (HsProc xp pat gl) = _
-testMe (HsStatic xs gl) = _
-testMe (XExpr xe) = _
diff --git a/testsuite/tests/typecheck/should_compile/hard_hole_fits.stderr b/testsuite/tests/typecheck/should_compile/hard_hole_fits.stderr
deleted file mode 100644
index 672cca7440..0000000000
--- a/testsuite/tests/typecheck/should_compile/hard_hole_fits.stderr
+++ /dev/null
@@ -1,679 +0,0 @@
-
-hard_hole_fits.hs:14:22: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsVar a b) = _
- • Relevant bindings include
- b :: Language.Haskell.Syntax.Extension.LIdP GhcPs
- (bound at hard_hole_fits.hs:14:17)
- a :: Language.Haskell.Syntax.Extension.XVar GhcPs
- (bound at hard_hole_fits.hs:14:15)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:15:32: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsUnboundVar xuv uv) = _
- • Relevant bindings include
- uv :: GHC.Types.Name.Occurrence.OccName
- (bound at hard_hole_fits.hs:15:26)
- xuv :: Language.Haskell.Syntax.Extension.XUnboundVar GhcPs
- (bound at hard_hole_fits.hs:15:22)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:16:33: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsOverLabel xol m_ip) = _
- • Relevant bindings include
- m_ip :: GHC.Data.FastString.FastString
- (bound at hard_hole_fits.hs:16:25)
- xol :: Language.Haskell.Syntax.Extension.XOverLabel GhcPs
- (bound at hard_hole_fits.hs:16:21)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:17:27: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsIPVar xv hin) = _
- • Relevant bindings include
- hin :: Language.Haskell.Syntax.Type.HsIPName
- (bound at hard_hole_fits.hs:17:20)
- xv :: Language.Haskell.Syntax.Extension.XIPVar GhcPs
- (bound at hard_hole_fits.hs:17:17)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:18:31: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsOverLit xole hol) = _
- • Relevant bindings include
- hol :: Language.Haskell.Syntax.Lit.HsOverLit GhcPs
- (bound at hard_hole_fits.hs:18:24)
- xole :: Language.Haskell.Syntax.Extension.XOverLitE GhcPs
- (bound at hard_hole_fits.hs:18:19)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:19:25: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsLit xle hl) = _
- • Relevant bindings include
- hl :: Language.Haskell.Syntax.Lit.HsLit GhcPs
- (bound at hard_hole_fits.hs:19:19)
- xle :: Language.Haskell.Syntax.Extension.XLitE GhcPs
- (bound at hard_hole_fits.hs:19:15)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:20:24: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsLam xl mg) = _
- • Relevant bindings include
- mg :: MatchGroup GhcPs (LHsExpr GhcPs)
- (bound at hard_hole_fits.hs:20:18)
- xl :: Language.Haskell.Syntax.Extension.XLam GhcPs
- (bound at hard_hole_fits.hs:20:15)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:21:29: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsLamCase xlc lc_variant mg) = _
- • Relevant bindings include
- mg :: MatchGroup GhcPs (LHsExpr GhcPs)
- (bound at hard_hole_fits.hs:21:23)
- xlc :: Language.Haskell.Syntax.Extension.XLamCase GhcPs
- (bound at hard_hole_fits.hs:21:19)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:22:28: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsApp xa gl gl') = _
- • Relevant bindings include
- gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:22:21)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:22:18)
- xa :: Language.Haskell.Syntax.Extension.XApp GhcPs
- (bound at hard_hole_fits.hs:22:15)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:23:35: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsAppType xate gl hwcb) = _
- • Relevant bindings include
- hwcb :: Language.Haskell.Syntax.Type.LHsWcType
- (Language.Haskell.Syntax.Extension.NoGhcTc GhcPs)
- (bound at hard_hole_fits.hs:23:27)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:23:24)
- xate :: Language.Haskell.Syntax.Extension.XAppTypeE GhcPs
- (bound at hard_hole_fits.hs:23:19)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:24:33: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (OpApp xoa gl gl' gl2) = _
- • Relevant bindings include
- gl2 :: LHsExpr GhcPs (bound at hard_hole_fits.hs:24:26)
- gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:24:22)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:24:19)
- xoa :: Language.Haskell.Syntax.Extension.XOpApp GhcPs
- (bound at hard_hole_fits.hs:24:15)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:25:29: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (NegApp xna gl se) = _
- • Relevant bindings include
- se :: SyntaxExpr GhcPs (bound at hard_hole_fits.hs:25:23)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:25:20)
- xna :: Language.Haskell.Syntax.Extension.XNegApp GhcPs
- (bound at hard_hole_fits.hs:25:16)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:26:30: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsPar xp gl ab ac) = _
- • Relevant bindings include
- ac :: Language.Haskell.Syntax.Extension.LHsToken ")" GhcPs
- (bound at hard_hole_fits.hs:26:24)
- ab :: LHsExpr GhcPs (bound at hard_hole_fits.hs:26:21)
- gl :: Language.Haskell.Syntax.Extension.LHsToken "(" GhcPs
- (bound at hard_hole_fits.hs:26:18)
- xp :: Language.Haskell.Syntax.Extension.XPar GhcPs
- (bound at hard_hole_fits.hs:26:15)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:27:32: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (SectionL xsl gl gl') = _
- • Relevant bindings include
- gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:27:25)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:27:22)
- xsl :: Language.Haskell.Syntax.Extension.XSectionL GhcPs
- (bound at hard_hole_fits.hs:27:18)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:28:32: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (SectionR xsr gl gl') = _
- • Relevant bindings include
- gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:28:25)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:28:22)
- xsr :: Language.Haskell.Syntax.Extension.XSectionR GhcPs
- (bound at hard_hole_fits.hs:28:18)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:29:38: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’:
- testMe (ExplicitTuple xet gls box) = _
- • Relevant bindings include
- box :: GHC.Types.Basic.Boxity (bound at hard_hole_fits.hs:29:31)
- gls :: [HsTupArg GhcPs] (bound at hard_hole_fits.hs:29:27)
- xet :: Language.Haskell.Syntax.Extension.XExplicitTuple GhcPs
- (bound at hard_hole_fits.hs:29:23)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:30:35: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (ExplicitSum xes n i gl) = _
- • Relevant bindings include
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:30:29)
- i :: GHC.Types.Basic.Arity (bound at hard_hole_fits.hs:30:27)
- n :: GHC.Types.Basic.ConTag (bound at hard_hole_fits.hs:30:25)
- xes :: Language.Haskell.Syntax.Extension.XExplicitSum GhcPs
- (bound at hard_hole_fits.hs:30:21)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- n :: GHC.Types.Basic.ConTag (bound at hard_hole_fits.hs:30:25)
- i :: GHC.Types.Basic.Arity (bound at hard_hole_fits.hs:30:27)
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:31:28: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsCase xc gl mg) = _
- • Relevant bindings include
- mg :: MatchGroup GhcPs (LHsExpr GhcPs)
- (bound at hard_hole_fits.hs:31:22)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:31:19)
- xc :: Language.Haskell.Syntax.Extension.XCase GhcPs
- (bound at hard_hole_fits.hs:31:16)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:32:33: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsIf xi m_se gl gl') = _
- • Relevant bindings include
- gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:32:25)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:32:22)
- m_se :: LHsExpr GhcPs (bound at hard_hole_fits.hs:32:17)
- xi :: Language.Haskell.Syntax.Extension.XIf GhcPs
- (bound at hard_hole_fits.hs:32:14)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:33:30: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsMultiIf xmi gls) = _
- • Relevant bindings include
- gls :: [LGRHS GhcPs (LHsExpr GhcPs)]
- (bound at hard_hole_fits.hs:33:23)
- xmi :: Language.Haskell.Syntax.Extension.XMultiIf GhcPs
- (bound at hard_hole_fits.hs:33:19)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:34:39: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’:
- testMe (HsLet xl tkLet gl tkIn gl') = _
- • Relevant bindings include
- gl' :: LHsExpr GhcPs (bound at hard_hole_fits.hs:34:32)
- tkIn :: Language.Haskell.Syntax.Extension.LHsToken "in" GhcPs
- (bound at hard_hole_fits.hs:34:27)
- gl :: Language.Haskell.Syntax.Binds.HsLocalBinds GhcPs
- (bound at hard_hole_fits.hs:34:24)
- tkLet :: Language.Haskell.Syntax.Extension.LHsToken "let" GhcPs
- (bound at hard_hole_fits.hs:34:18)
- xl :: Language.Haskell.Syntax.Extension.XLet GhcPs
- (bound at hard_hole_fits.hs:34:15)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:35:27: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsDo xd hsc gl) = _
- • Relevant bindings include
- gl :: Language.Haskell.Syntax.Extension.XRec
- GhcPs [ExprLStmt GhcPs]
- (bound at hard_hole_fits.hs:35:21)
- hsc :: HsDoFlavour (bound at hard_hole_fits.hs:35:17)
- xd :: Language.Haskell.Syntax.Extension.XDo GhcPs
- (bound at hard_hole_fits.hs:35:14)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:36:34: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (ExplicitList xel m_se) = _
- • Relevant bindings include
- m_se :: [LHsExpr GhcPs] (bound at hard_hole_fits.hs:36:26)
- xel :: Language.Haskell.Syntax.Extension.XExplicitList GhcPs
- (bound at hard_hole_fits.hs:36:22)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:37:33: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (RecordCon xrc gl hrf) = _
- • Relevant bindings include
- hrf :: HsRecordBinds GhcPs (bound at hard_hole_fits.hs:37:26)
- gl :: Language.Haskell.Syntax.Extension.XRec
- GhcPs (Language.Haskell.Syntax.Pat.ConLikeP GhcPs)
- (bound at hard_hole_fits.hs:37:23)
- xrc :: Language.Haskell.Syntax.Extension.XRecordCon GhcPs
- (bound at hard_hole_fits.hs:37:19)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:38:33: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (RecordUpd xru gl gls) = _
- • Relevant bindings include
- gls :: Either
- [Language.Haskell.Syntax.Pat.LHsRecUpdField GhcPs]
- [LHsRecUpdProj GhcPs]
- (bound at hard_hole_fits.hs:38:26)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:38:23)
- xru :: Language.Haskell.Syntax.Extension.XRecordUpd GhcPs
- (bound at hard_hole_fits.hs:38:19)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:39:40: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’:
- testMe (ExprWithTySig xewts gl hwcb) = _
- • Relevant bindings include
- hwcb :: Language.Haskell.Syntax.Type.LHsSigWcType
- (Language.Haskell.Syntax.Extension.NoGhcTc GhcPs)
- (bound at hard_hole_fits.hs:39:32)
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:39:29)
- xewts :: Language.Haskell.Syntax.Extension.XExprWithTySig GhcPs
- (bound at hard_hole_fits.hs:39:23)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:40:34: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (ArithSeq xas m_se asi) = _
- • Relevant bindings include
- asi :: ArithSeqInfo GhcPs (bound at hard_hole_fits.hs:40:27)
- m_se :: Maybe (SyntaxExpr GhcPs) (bound at hard_hole_fits.hs:40:22)
- xas :: Language.Haskell.Syntax.Extension.XArithSeq GhcPs
- (bound at hard_hole_fits.hs:40:18)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:41:28: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsBracket xb hb) = _
- • Relevant bindings include
- hb :: HsBracket GhcPs (bound at hard_hole_fits.hs:41:22)
- xb :: Language.Haskell.Syntax.Extension.XBracket GhcPs
- (bound at hard_hole_fits.hs:41:19)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:42:40: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’:
- testMe (HsRnBracketOut xrbo hb prss) = _
- • Relevant bindings include
- prss :: [PendingRnSplice' GhcPs] (bound at hard_hole_fits.hs:42:32)
- hb :: HsBracket (HsBracketRn GhcPs)
- (bound at hard_hole_fits.hs:42:29)
- xrbo :: Language.Haskell.Syntax.Extension.XRnBracketOut GhcPs
- (bound at hard_hole_fits.hs:42:24)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:43:43: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’:
- testMe (HsTcBracketOut xtbo hb ptss as) = _
- • Relevant bindings include
- as :: [PendingTcSplice' GhcPs] (bound at hard_hole_fits.hs:43:37)
- ptss :: HsBracket (HsBracketRn GhcPs)
- (bound at hard_hole_fits.hs:43:32)
- hb :: Maybe GHC.Tc.Types.Evidence.QuoteWrapper
- (bound at hard_hole_fits.hs:43:29)
- xtbo :: Language.Haskell.Syntax.Extension.XTcBracketOut GhcPs
- (bound at hard_hole_fits.hs:43:24)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:44:29: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsSpliceE xse hs) = _
- • Relevant bindings include
- hs :: HsSplice GhcPs (bound at hard_hole_fits.hs:44:23)
- xse :: Language.Haskell.Syntax.Extension.XSpliceE GhcPs
- (bound at hard_hole_fits.hs:44:19)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:45:29: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsProc xp pat gl) = _
- • Relevant bindings include
- gl :: LHsCmdTop GhcPs (bound at hard_hole_fits.hs:45:23)
- pat :: Language.Haskell.Syntax.Pat.LPat GhcPs
- (bound at hard_hole_fits.hs:45:19)
- xp :: Language.Haskell.Syntax.Extension.XProc GhcPs
- (bound at hard_hole_fits.hs:45:16)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:46:27: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (HsStatic xs gl) = _
- • Relevant bindings include
- gl :: LHsExpr GhcPs (bound at hard_hole_fits.hs:46:21)
- xs :: Language.Haskell.Syntax.Extension.XStatic GhcPs
- (bound at hard_hole_fits.hs:46:18)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
-
-hard_hole_fits.hs:47:1: warning: [-Woverlapping-patterns (in -Wdefault)]
- Pattern match is redundant
- In an equation for ‘testMe’: testMe (XExpr xe) = ...
-
-hard_hole_fits.hs:47:21: warning: [-Wtyped-holes (in -Wdefault)]
- • Found hole: _ :: Int
- • In an equation for ‘testMe’: testMe (XExpr xe) = _
- • Relevant bindings include
- xe :: Language.Haskell.Syntax.Extension.XXExpr GhcPs
- (bound at hard_hole_fits.hs:47:15)
- testMe :: HsExpr GhcPs -> Int (bound at hard_hole_fits.hs:14:1)
- Valid hole fits include
- maxBound :: forall a. Bounded a => a
- with maxBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))
- minBound :: forall a. Bounded a => a
- with minBound @Int
- (imported from ‘Prelude’ at hard_hole_fits.hs:8:8-20
- (and originally defined in ‘GHC.Enum’))