From 41de40ea637231be3ceb1355513f6a99c0c6026f Mon Sep 17 00:00:00 2001 From: Jan Hrcek <2716069+jhrcek@users.noreply.github.com> Date: Wed, 28 Feb 2024 09:52:59 +0100 Subject: [PATCH] Remove more workarounds for GHCs < 9.2 (#4092) (#4098) * Remove more workarounds for GHCs < 9.2 (#4092) * Delete removed module from cabal file * Remove unused package --- ghcide/ghcide.cabal | 8 +-- .../test/data/plugin-recorddot/RecordDot.hs | 6 -- .../test/data/plugin-recorddot/cabal.project | 1 - .../test/data/plugin-recorddot/plugin.cabal | 9 --- ghcide/test/exe/CodeLensTests.hs | 2 +- ghcide/test/exe/DependentFileTest.hs | 3 +- .../test/exe/FindDefinitionAndHoverTests.hs | 16 ++--- ghcide/test/exe/Main.hs | 2 - ghcide/test/exe/PluginParsedResultTests.hs | 16 ----- ghcide/test/exe/TestUtils.hs | 3 - plugins/hls-eval-plugin/test/Main.hs | 25 +++----- .../test/testdata/T10.expected.hs | 2 +- .../test/testdata/T10.ghc92.expected | 11 ---- .../test/testdata/T10.ghc92.expected.hs | 11 ---- .../test/testdata/T11.expected.hs | 2 +- .../test/testdata/T12.expected.hs | 2 +- .../test/testdata/T12.ghc92.expected.hs | 10 --- .../test/testdata/T12.ghc92_expected.hs | 10 --- .../test/testdata/T13.expected.hs | 2 +- .../test/testdata/T13.ghc92.expected.hs | 4 -- .../test/testdata/T13.ghc92_expected.hs | 4 -- .../test/testdata/T15.ghc92_expected.hs | 8 --- .../test/testdata/T17.expected.hs | 2 +- .../test/testdata/T17.ghc92.expected.hs | 4 -- .../test/testdata/T17.ghc92_expected.hs | 4 -- .../test/testdata/T20.ghc92.expected.hs | 7 -- .../test/testdata/T20.ghc92_expected.hs | 7 -- .../test/testdata/TFlags.expected.hs | 6 +- .../test/testdata/TFlags.ghc92.expected.hs | 64 ------------------- 29 files changed, 30 insertions(+), 221 deletions(-) delete mode 100644 ghcide/test/data/plugin-recorddot/RecordDot.hs delete mode 100644 ghcide/test/data/plugin-recorddot/cabal.project delete mode 100644 ghcide/test/data/plugin-recorddot/plugin.cabal delete mode 100644 ghcide/test/exe/PluginParsedResultTests.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected delete mode 100644 plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T12.ghc92.expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T12.ghc92_expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T13.ghc92_expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T15.ghc92_expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T17.ghc92.expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T17.ghc92_expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T20.ghc92.expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/T20.ghc92_expected.hs delete mode 100644 plugins/hls-eval-plugin/test/testdata/TFlags.ghc92.expected.hs diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index fc95686d14..6bdc3c9c86 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -285,7 +285,7 @@ library ghcide-test-utils visibility: public default-language: GHC2021 - hs-source-dirs: test/src test/cabal + hs-source-dirs: test/src test/cabal exposed-modules: Development.IDE.Test Development.IDE.Test.Runfiles @@ -306,14 +306,13 @@ library ghcide-test-utils lsp-test ^>= 0.17, tasty-hunit >= 0.10, text, - row-types, default-extensions: LambdaCase OverloadedStrings RecordWildCards ViewPatterns - + test-suite ghcide-tests import: warnings type: exitcode-stdio-1.0 @@ -365,7 +364,7 @@ test-suite ghcide-tests if impl(ghc <9.3) build-depends: ghc-typelits-knownnat - hs-source-dirs: test/exe + hs-source-dirs: test/exe ghc-options: -threaded -O0 main-is: Main.hs @@ -392,7 +391,6 @@ test-suite ghcide-tests NonLspCommandLine OpenCloseTest OutlineTests - PluginParsedResultTests PluginSimpleTests PositionMappingTests PreprocessorTests diff --git a/ghcide/test/data/plugin-recorddot/RecordDot.hs b/ghcide/test/data/plugin-recorddot/RecordDot.hs deleted file mode 100644 index a0e30599e9..0000000000 --- a/ghcide/test/data/plugin-recorddot/RecordDot.hs +++ /dev/null @@ -1,6 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields, TypeApplications, TypeFamilies, UndecidableInstances, FlexibleContexts, DataKinds, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances #-} -{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-} -module RecordDot (Company(..), display) where -data Company = Company {name :: String} -display :: Company -> String -display c = c.name diff --git a/ghcide/test/data/plugin-recorddot/cabal.project b/ghcide/test/data/plugin-recorddot/cabal.project deleted file mode 100644 index e6fdbadb43..0000000000 --- a/ghcide/test/data/plugin-recorddot/cabal.project +++ /dev/null @@ -1 +0,0 @@ -packages: . diff --git a/ghcide/test/data/plugin-recorddot/plugin.cabal b/ghcide/test/data/plugin-recorddot/plugin.cabal deleted file mode 100644 index bd85313914..0000000000 --- a/ghcide/test/data/plugin-recorddot/plugin.cabal +++ /dev/null @@ -1,9 +0,0 @@ -cabal-version: 1.18 -name: plugin -version: 1.0.0 -build-type: Simple - -library - build-depends: base, record-dot-preprocessor, record-hasfield - exposed-modules: RecordDot - hs-source-dirs: . diff --git a/ghcide/test/exe/CodeLensTests.hs b/ghcide/test/exe/CodeLensTests.hs index 0e575421b6..e6cb6a4062 100644 --- a/ghcide/test/exe/CodeLensTests.hs +++ b/ghcide/test/exe/CodeLensTests.hs @@ -86,7 +86,7 @@ addSigLensesTests = , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, String)") , ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"") , ("promotedKindTest = Proxy @Nothing", if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing") - , ("typeOperatorTest = Refl", if ghcVersion >= GHC92 then "typeOperatorTest :: forall {k} {a :: k}. a :~: a" else "typeOperatorTest :: a :~: a") + , ("typeOperatorTest = Refl", "typeOperatorTest :: forall {k} {a :: k}. a :~: a") , ("notInScopeTest = mkCharType", "notInScopeTest :: String -> Data.Data.DataType") , ("aVeryLongSignature a b c d e f g h i j k l m n = a && b && c && d && e && f && g && h && i && j && k && l && m && n", "aVeryLongSignature :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool") ] diff --git a/ghcide/test/exe/DependentFileTest.hs b/ghcide/test/exe/DependentFileTest.hs index 3a6f9471de..d5fff45bea 100644 --- a/ghcide/test/exe/DependentFileTest.hs +++ b/ghcide/test/exe/DependentFileTest.hs @@ -7,7 +7,6 @@ module DependentFileTest (tests) where import Control.Monad.IO.Class (liftIO) import Data.Row import qualified Data.Text as T -import Development.IDE.GHC.Compat (GhcVersion (..), ghcVersion) import Development.IDE.Test (expectDiagnostics) import Development.IDE.Types.Location import Language.LSP.Protocol.Message @@ -45,7 +44,7 @@ tests = testGroup "addDependentFile" _ <- createDoc "Foo.hs" "haskell" fooContent doc <- createDoc "Baz.hs" "haskell" bazContent expectDiagnostics - [("Foo.hs", [(DiagnosticSeverity_Error, if ghcVersion >= GHC92 then (4,11) else (4, 6), "Couldn't match type")])] + [("Foo.hs", [(DiagnosticSeverity_Error, (4,11), "Couldn't match type")])] -- Now modify the dependent file liftIO $ writeFile depFilePath "B" sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams diff --git a/ghcide/test/exe/FindDefinitionAndHoverTests.hs b/ghcide/test/exe/FindDefinitionAndHoverTests.hs index 1b597bca0a..bfa3be7f28 100644 --- a/ghcide/test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide/test/exe/FindDefinitionAndHoverTests.hs @@ -113,13 +113,11 @@ tests = let typeDefinitionTests = [ tst (getTypeDefinitions, checkDefs) aaaL14 sourceFilePath (pure tcData) "Saturated data con" , tst (getTypeDefinitions, checkDefs) aL20 sourceFilePath (pure [ExpectNoDefinitions]) "Polymorphic variable"] - recordDotSyntaxTests - | ghcVersion >= GHC92 = - [ tst (getHover, checkHover) (Position 17 24) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["x :: MyRecord"]]) "hover over parent" - , tst (getHover, checkHover) (Position 17 25) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over dot shows child" - , tst (getHover, checkHover) (Position 17 26) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over child" - ] - | otherwise = [] + recordDotSyntaxTests = + [ tst (getHover, checkHover) (Position 17 24) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["x :: MyRecord"]]) "hover over parent" + , tst (getHover, checkHover) (Position 17 25) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over dot shows child" + , tst (getHover, checkHover) (Position 17 26) (T.unpack "RecordDotSyntax.hs") (pure [ExpectHoverText ["_ :: MyChild"]]) "hover over child" + ] test runDef runHover look expect = testM runDef runHover look (return expect) @@ -157,8 +155,8 @@ tests = let spaceL37 = Position 41 24 ; space = [ExpectNoDefinitions, ExpectHoverText [":: Char"]] docL41 = Position 45 1 ; doc = [ExpectHoverText ["Recognizable docs: kpqz"]] ; constr = [ExpectHoverText ["Monad m"]] - eitL40 = Position 44 28 ; kindE = [ExpectHoverText [if ghcVersion >= GHC92 then ":: Type -> Type -> Type\n" else ":: * -> * -> *\n"]] - intL40 = Position 44 34 ; kindI = [ExpectHoverText [if ghcVersion >= GHC92 then ":: Type\n" else ":: *\n"]] + eitL40 = Position 44 28 ; kindE = [ExpectHoverText [":: Type -> Type -> Type\n"]] + intL40 = Position 44 34 ; kindI = [ExpectHoverText [":: Type\n"]] tvrL40 = Position 44 37 ; kindV = [ExpectHoverText [":: * -> *\n"]] intL41 = Position 45 20 ; litI = [ExpectHoverText ["7518"]] chrL36 = Position 41 24 ; litC = [ExpectHoverText ["'f'"]] diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 18296dce16..412a6969fe 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -56,7 +56,6 @@ import OutlineTests import HighlightTests import FindDefinitionAndHoverTests import PluginSimpleTests -import PluginParsedResultTests import PreprocessorTests import THTests import SymlinkTests @@ -103,7 +102,6 @@ main = do , HighlightTests.tests , FindDefinitionAndHoverTests.tests , PluginSimpleTests.tests - , PluginParsedResultTests.tests , PreprocessorTests.tests , THTests.tests , SymlinkTests.tests diff --git a/ghcide/test/exe/PluginParsedResultTests.hs b/ghcide/test/exe/PluginParsedResultTests.hs deleted file mode 100644 index f33a998df9..0000000000 --- a/ghcide/test/exe/PluginParsedResultTests.hs +++ /dev/null @@ -1,16 +0,0 @@ - -module PluginParsedResultTests (tests) where - -import Development.IDE.Test (expectNoMoreDiagnostics) -import Language.LSP.Test -import System.FilePath --- import Test.QuickCheck.Instances () -import Test.Tasty -import TestUtils - -tests :: TestTree -tests = - ignoreForGHC92Plus "No need for this plugin anymore!" $ - testSessionWithExtraFiles "plugin-recorddot" "parsedResultAction plugin" $ \dir -> do - _ <- openDoc (dir "RecordDot.hs") "haskell" - expectNoMoreDiagnostics 2 diff --git a/ghcide/test/exe/TestUtils.hs b/ghcide/test/exe/TestUtils.hs index 78ad250ef9..151dba96bd 100644 --- a/ghcide/test/exe/TestUtils.hs +++ b/ghcide/test/exe/TestUtils.hs @@ -163,9 +163,6 @@ xfail = flip expectFailBecause ignoreInWindowsBecause :: String -> TestTree -> TestTree ignoreInWindowsBecause = ignoreFor (BrokenForOS Windows) -ignoreForGHC92Plus :: String -> TestTree -> TestTree -ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94, GHC96, GHC98]) - knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers) diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index d7f5b42300..fa3fe1fb5b 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -78,26 +78,22 @@ tests = else "-- No instance for (Num String) arising from a use of `+'\n-- In the expression: \"a\" + \"bc\"\n-- In an equation for `res': res = \"a\" + \"bc\"" - evalInFile "T8.hs" "-- >>> \"" "-- lexical error in string/character literal at end of input" evalInFile "T8.hs" "-- >>> 3 `div` 0" "-- divide by zero" -- The default for marking exceptions is False , goldenWithEval "Applies file LANGUAGE extensions" "T9" "hs" - , goldenWithEval' "Evaluate a type with :kind!" "T10" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") - , goldenWithEval' "Reports an error for an incorrect type with :kind!" "T11" "hs" ( - if ghcVersion >= GHC94 then "ghc94.expected" - else if ghcVersion >= GHC92 then "ghc92.expected" - else "expected" - ) - , goldenWithEval' "Shows a kind with :kind" "T12" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") - , goldenWithEval' "Reports an error for an incorrect type with :kind" "T13" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") + , goldenWithEval "Evaluate a type with :kind!" "T10" "hs" + , goldenWithEval' "Reports an error for an incorrect type with :kind!" "T11" "hs" + (if ghcVersion >= GHC94 then "ghc94.expected" else "expected") + , goldenWithEval "Shows a kind with :kind" "T12" "hs" + , goldenWithEval "Reports an error for an incorrect type with :kind" "T13" "hs" , goldenWithEval' "Returns a fully-instantiated type for :type" "T14" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") -- See https://gitlab.haskell.org/ghc/ghc/-/issues/24069 , knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" , goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs" - , goldenWithEval' ":type reports an error when given with unknown +x option" "T17" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") + , goldenWithEval ":type reports an error when given with unknown +x option" "T17" "hs" , goldenWithEval "Reports an error when given with unknown command" "T18" "hs" , goldenWithEval "Returns defaulted type for :type +d reflecting the default declaration specified in the >>> prompt" "T19" "hs" , expectFailBecause "known issue - see a note in P.R. #361" $ - goldenWithEval' ":type +d reflects the `default' declaration of the module" "T20" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") + goldenWithEval ":type +d reflects the `default' declaration of the module" "T20" "hs" , testCase ":type handles a multilined result properly" $ evalInFile "T21.hs" "-- >>> :type fun" $ T.unlines [ "-- fun", @@ -125,13 +121,10 @@ tests = , goldenWithEvalAndFs "Transitive local dependency" (FS.directProjectMulti ["TTransitive.hs", "TLocalImport.hs", "Util.hs"]) "TTransitive" "hs" -- , goldenWithEval "Local Modules can be imported in a test" "TLocalImportInTest" "hs" , goldenWithEval "Setting language option TupleSections" "TLanguageOptionsTupleSections" "hs" - , goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else if ghcVersion >= GHC92 then "ghc92.expected" else "expected") + , goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") , testCase ":set -fprint-explicit-foralls works" $ do evalInFile "T8.hs" "-- >>> :t id" "-- id :: a -> a" - evalInFile "T8.hs" "-- >>> :set -fprint-explicit-foralls\n-- >>> :t id" - (if ghcVersion >= GHC92 - then "-- id :: forall a. a -> a" - else "-- id :: forall {a}. a -> a") + evalInFile "T8.hs" "-- >>> :set -fprint-explicit-foralls\n-- >>> :t id" "-- id :: forall a. a -> a" , goldenWithEval "The default language extensions for the eval plugin are the same as those for ghci" "TSameDefaultLanguageExtensionsAsGhci" "hs" , goldenWithEval "IO expressions are supported, stdout/stderr output is ignored" "TIO" "hs" , goldenWithEvalAndFs "Property checking" cabalProjectFS "TProperty" "hs" diff --git a/plugins/hls-eval-plugin/test/testdata/T10.expected.hs b/plugins/hls-eval-plugin/test/testdata/T10.expected.hs index 2c50750981..776c970591 100644 --- a/plugins/hls-eval-plugin/test/testdata/T10.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T10.expected.hs @@ -7,5 +7,5 @@ type Dummy = 1 + 1 -- >>> type N = 1 -- >>> type M = 40 -- >>> :kind! N + M + 1 --- N + M + 1 :: Nat +-- N + M + 1 :: Natural -- = 42 diff --git a/plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected b/plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected deleted file mode 100644 index 776c970591..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE DataKinds, TypeOperators #-} -module T10 where -import GHC.TypeNats ( type (+) ) - -type Dummy = 1 + 1 - --- >>> type N = 1 --- >>> type M = 40 --- >>> :kind! N + M + 1 --- N + M + 1 :: Natural --- = 42 diff --git a/plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected.hs b/plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected.hs deleted file mode 100644 index 776c970591..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T10.ghc92.expected.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE DataKinds, TypeOperators #-} -module T10 where -import GHC.TypeNats ( type (+) ) - -type Dummy = 1 + 1 - --- >>> type N = 1 --- >>> type M = 40 --- >>> :kind! N + M + 1 --- N + M + 1 :: Natural --- = 42 diff --git a/plugins/hls-eval-plugin/test/testdata/T11.expected.hs b/plugins/hls-eval-plugin/test/testdata/T11.expected.hs index eb472f9002..63d0ed8a07 100644 --- a/plugins/hls-eval-plugin/test/testdata/T11.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T11.expected.hs @@ -1,4 +1,4 @@ module T11 where -- >>> :kind! A --- Not in scope: type constructor or class ‘A’ +-- Not in scope: type constructor or class `A' diff --git a/plugins/hls-eval-plugin/test/testdata/T12.expected.hs b/plugins/hls-eval-plugin/test/testdata/T12.expected.hs index 81bf5c30c2..4f0dd67b82 100644 --- a/plugins/hls-eval-plugin/test/testdata/T12.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T12.expected.hs @@ -7,4 +7,4 @@ type Dummy = 1 + 1 -- >>> type N = 1 -- >>> type M = 40 -- >>> :kind N + M + 1 --- N + M + 1 :: Nat +-- N + M + 1 :: Natural diff --git a/plugins/hls-eval-plugin/test/testdata/T12.ghc92.expected.hs b/plugins/hls-eval-plugin/test/testdata/T12.ghc92.expected.hs deleted file mode 100644 index 4f0dd67b82..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T12.ghc92.expected.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE DataKinds, TypeOperators #-} -module T12 where -import GHC.TypeNats ( type (+) ) - -type Dummy = 1 + 1 - --- >>> type N = 1 --- >>> type M = 40 --- >>> :kind N + M + 1 --- N + M + 1 :: Natural diff --git a/plugins/hls-eval-plugin/test/testdata/T12.ghc92_expected.hs b/plugins/hls-eval-plugin/test/testdata/T12.ghc92_expected.hs deleted file mode 100644 index 4f0dd67b82..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T12.ghc92_expected.hs +++ /dev/null @@ -1,10 +0,0 @@ -{-# LANGUAGE DataKinds, TypeOperators #-} -module T12 where -import GHC.TypeNats ( type (+) ) - -type Dummy = 1 + 1 - --- >>> type N = 1 --- >>> type M = 40 --- >>> :kind N + M + 1 --- N + M + 1 :: Natural diff --git a/plugins/hls-eval-plugin/test/testdata/T13.expected.hs b/plugins/hls-eval-plugin/test/testdata/T13.expected.hs index 60d6787d55..60a75bdfdd 100644 --- a/plugins/hls-eval-plugin/test/testdata/T13.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T13.expected.hs @@ -1,4 +1,4 @@ module T13 where -- >>> :kind A --- Not in scope: type constructor or class ‘A’ +-- Not in scope: type constructor or class `A' diff --git a/plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs b/plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs deleted file mode 100644 index 60a75bdfdd..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T13.ghc92.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -module T13 where - --- >>> :kind A --- Not in scope: type constructor or class `A' diff --git a/plugins/hls-eval-plugin/test/testdata/T13.ghc92_expected.hs b/plugins/hls-eval-plugin/test/testdata/T13.ghc92_expected.hs deleted file mode 100644 index f5a6d1655f..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T13.ghc92_expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -module T13 where - --- >>> :kind a --- Not in scope: type variable `a' diff --git a/plugins/hls-eval-plugin/test/testdata/T15.ghc92_expected.hs b/plugins/hls-eval-plugin/test/testdata/T15.ghc92_expected.hs deleted file mode 100644 index 54f0f38ef5..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T15.ghc92_expected.hs +++ /dev/null @@ -1,8 +0,0 @@ -{-# LANGUAGE TypeApplications #-} -module T15 where - -foo :: Show a => a -> String -foo = show - --- >>> :type +v foo @Int --- foo @Int :: Show Int => Int -> String diff --git a/plugins/hls-eval-plugin/test/testdata/T17.expected.hs b/plugins/hls-eval-plugin/test/testdata/T17.expected.hs index 14e2aa74a1..caf06a9fee 100644 --- a/plugins/hls-eval-plugin/test/testdata/T17.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/T17.expected.hs @@ -1,4 +1,4 @@ module T17 where -- >>> :type +no 42 --- parse error on input ‘+’ +-- parse error on input `+' diff --git a/plugins/hls-eval-plugin/test/testdata/T17.ghc92.expected.hs b/plugins/hls-eval-plugin/test/testdata/T17.ghc92.expected.hs deleted file mode 100644 index caf06a9fee..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T17.ghc92.expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -module T17 where - --- >>> :type +no 42 --- parse error on input `+' diff --git a/plugins/hls-eval-plugin/test/testdata/T17.ghc92_expected.hs b/plugins/hls-eval-plugin/test/testdata/T17.ghc92_expected.hs deleted file mode 100644 index 14e2aa74a1..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T17.ghc92_expected.hs +++ /dev/null @@ -1,4 +0,0 @@ -module T17 where - --- >>> :type +no 42 --- parse error on input ‘+’ diff --git a/plugins/hls-eval-plugin/test/testdata/T20.ghc92.expected.hs b/plugins/hls-eval-plugin/test/testdata/T20.ghc92.expected.hs deleted file mode 100644 index 18d2155560..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T20.ghc92.expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -module T20 where -import Data.Word (Word) - -default (Word) - --- >>> :type +d 40+ 2 --- 40+ 2 :: Word diff --git a/plugins/hls-eval-plugin/test/testdata/T20.ghc92_expected.hs b/plugins/hls-eval-plugin/test/testdata/T20.ghc92_expected.hs deleted file mode 100644 index 36c93b99c1..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/T20.ghc92_expected.hs +++ /dev/null @@ -1,7 +0,0 @@ -module T20 where -import Data.Word (Word) - -default (Word) - --- >>> :type +d 40+ 2 --- 40+ 2 :: Integer diff --git a/plugins/hls-eval-plugin/test/testdata/TFlags.expected.hs b/plugins/hls-eval-plugin/test/testdata/TFlags.expected.hs index 8bf91c7118..2c8e0ef92a 100644 --- a/plugins/hls-eval-plugin/test/testdata/TFlags.expected.hs +++ b/plugins/hls-eval-plugin/test/testdata/TFlags.expected.hs @@ -20,8 +20,9 @@ module TFlags where Options apply only in the section where they are defined (unless they are in the setup section), so this will fail: >>> class L a b c -Too many parameters for class ‘L’ +Too many parameters for class `L' (Enable MultiParamTypeClasses to allow multi-parameter classes) +In the class declaration for `L' -} @@ -31,8 +32,9 @@ Options apply to all tests in the same section after their declaration. Not set yet: >>> class D -No parameters for class ‘D’ +No parameters for class `D' (Enable MultiParamTypeClasses to allow no-parameter classes) +In the class declaration for `D' Now it works: diff --git a/plugins/hls-eval-plugin/test/testdata/TFlags.ghc92.expected.hs b/plugins/hls-eval-plugin/test/testdata/TFlags.ghc92.expected.hs deleted file mode 100644 index 2c8e0ef92a..0000000000 --- a/plugins/hls-eval-plugin/test/testdata/TFlags.ghc92.expected.hs +++ /dev/null @@ -1,64 +0,0 @@ --- Support for language options - -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE Haskell2010 #-} - -module TFlags where - --- Language options set in the module source (ScopedTypeVariables) --- also apply to tests so this works fine --- >>> f = (\(c::Char) -> [c]) - -{- Multiple options can be set with a single `:set` - ->>> :set -XMultiParamTypeClasses -XFlexibleInstances ->>> class Z a b c --} - -{- - -Options apply only in the section where they are defined (unless they are in the setup section), so this will fail: - ->>> class L a b c -Too many parameters for class `L' -(Enable MultiParamTypeClasses to allow multi-parameter classes) -In the class declaration for `L' --} - - -{- -Options apply to all tests in the same section after their declaration. - -Not set yet: - ->>> class D -No parameters for class `D' -(Enable MultiParamTypeClasses to allow no-parameter classes) -In the class declaration for `D' - -Now it works: - ->>>:set -XMultiParamTypeClasses ->>> class C - -It still works - ->>> class F --} - -{- Now -package flag is handled correctly: - ->>> :set -package ghc-prim ->>> import GHC.Prim - --} - - -{- Invalid option/flags are reported, but valid ones will be reflected - ->>> :set -XRank2Types -XAbsent -XDatatypeContexts -XWrong -fprint-nothing-at-all -: warning: - -XDatatypeContexts is deprecated: It was widely considered a misfeature, and has been removed from the Haskell language. -Some flags have not been recognized: -XAbsent, -XWrong, -fprint-nothing-at-all - --}