hls-eval-plugin 1.4.0.0 → 1.5.0.0
raw patch · 15 files changed
+194/−238 lines, 15 filesdep ~ghcidedep ~hls-test-utilsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghcide, hls-test-utils
API changes (from Hackage documentation)
Files
- hls-eval-plugin.cabal +2/−10
- src/Ide/Plugin/Eval/Code.hs +1/−7
- src/Ide/Plugin/Eval/CodeLens.hs +98/−187
- src/Ide/Plugin/Eval/Rules.hs +5/−0
- src/Ide/Plugin/Eval/Util.hs +26/−5
- test/Main.hs +28/−13
- test/testdata/T11.expected.hs +2/−2
- test/testdata/T11.ghc92.expected.hs +0/−4
- test/testdata/T11.ghc92_expected.hs +0/−4
- test/testdata/T11.hs +1/−1
- test/testdata/T13.expected.hs +2/−2
- test/testdata/T13.ghc92.expected.hs +2/−2
- test/testdata/T13.hs +1/−1
- test/testdata/TPropertyError.ghc94.expected.hs +13/−0
- test/testdata/TPropertyError.windows-ghc94.expected.hs +13/−0
hls-eval-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-eval-plugin-version: 1.4.0.0+version: 1.5.0.0 synopsis: Eval plugin for Haskell Language Server description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -37,10 +37,6 @@ location: https://github.com/haskell/haskell-language-server library- if impl(ghc >= 9.3)- buildable: False- else- buildable: True exposed-modules: Ide.Plugin.Eval Ide.Plugin.Eval.Types@@ -70,7 +66,7 @@ , ghc , ghc-boot-th , ghc-paths- , ghcide ^>=1.9+ , ghcide ^>=1.9 || ^>= 1.10 , hashable , hls-graph , hls-plugin-api ^>=1.6@@ -101,10 +97,6 @@ TypeOperators test-suite tests- if impl(ghc >= 9.3)- buildable: False- else- buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test
src/Ide/Plugin/Eval/Code.hs view
@@ -4,7 +4,7 @@ {-# OPTIONS_GHC -Wwarn -fno-warn-orphans #-} -- | Expression execution-module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, evalSetup, propSetup, testCheck, asStatements,myExecStmt) where+module Ide.Plugin.Eval.Code (Statement, testRanges, resultRange, propSetup, testCheck, asStatements,myExecStmt) where import Control.Lens ((^.)) import Control.Monad.IO.Class@@ -80,12 +80,6 @@ ["prop11 = " ++ t, "(propEvaluation prop11 :: IO String)"] --- |GHC declarations required for expression evaluation-evalSetup :: Ghc ()-evalSetup = do- preludeAsP <- parseImportDecl "import qualified Prelude as P"- context <- getContext- setContext (IIDecl preludeAsP : context) -- | A wrapper of 'InteractiveEval.execStmt', capturing the execution result myExecStmt :: String -> ExecOptions -> Ghc (Either String (Maybe String))
src/Ide/Plugin/Eval/CodeLens.hs view
@@ -11,7 +11,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-}-{-# OPTIONS_GHC -fno-warn-type-defaults #-}+{-# OPTIONS_GHC -fno-warn-type-defaults -Wno-unused-imports #-} {- | A plugin inspired by the REPLoid feature of <https://github.com/jyp/dante Dante>, <https://www.haskell.org/haddock/doc/html/ch03s08.html#idm140354810775744 Haddock>'s Examples and Properties and <https://hackage.haskell.org/package/doctest Doctest>.@@ -29,84 +29,81 @@ import qualified Control.Exception as E import Control.Lens (_1, _3, ix, (%~), (<&>), (^.))-import Control.Monad (guard, join,+import Control.Monad (guard, void, when) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Except (ExceptT (..)) import Data.Aeson (toJSON) import Data.Char (isSpace)-import Data.Default+import Data.Foldable (toList) import qualified Data.HashMap.Strict as HashMap import Data.List (dropWhileEnd, find, intercalate, intersperse)-import Data.Maybe (catMaybes,- fromMaybe)+import Data.Maybe (catMaybes) import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T-import Data.Time (getCurrentTime) import Data.Typeable (Typeable)-import Development.IDE (GetDependencyInformation (..),- GetLinkable (..),- GetModSummary (..),- GhcSessionIO (..),- IdeState,- ModSummaryResult (..),- NeedsCompilation (NeedsCompilation),- VFSModified (..),- evalGhcEnv,- hscEnvWithImportPaths,- linkableHomeMod,- printOutputable,- runAction,- textToStringBuffer,- toNormalizedFilePath',- uriToFilePath',- useNoFile_,- useWithStale_,- use_, uses_)-import Development.IDE.Core.Rules (GhcSessionDepsConfig (..),- ghcSessionDepsDefinition)+import Development.IDE.Core.RuleTypes+ ( NeedsCompilation(NeedsCompilation),+ LinkableResult(linkableHomeMod),+ tmrTypechecked,+ TypeCheck(..))+import Development.IDE.Core.Rules ( runAction, IdeState )+import Development.IDE.Core.Shake+ ( useWithStale_,+ use_,+ uses_ )+import Development.IDE.GHC.Util+ ( printOutputable, evalGhcEnv, modifyDynFlags )+import Development.IDE.Types.Location+ ( toNormalizedFilePath', uriToFilePath' ) import Development.IDE.GHC.Compat hiding (typeKind, unitState)-import qualified Development.IDE.GHC.Compat as Compat-import qualified Development.IDE.GHC.Compat as SrcLoc import Development.IDE.GHC.Compat.Util (GhcException, OverridingBool (..)) import Development.IDE.Import.DependencyInformation (reachableModules)-import Development.IDE.Types.Options import GHC (ClsInst, ExecOptions (execLineNumber, execSourceFile), FamInst, GhcMonad,- LoadHowMuch (LoadAllTargets), NamedThing (getName), defaultFixity, execOptions, exprType, getInfo, getInteractiveDynFlags,- isImport, isStmt,- load, parseName,+ isImport, isStmt, parseName, pprFamInst, pprInstance,- setTargets, typeKind)+++import Development.IDE.Core.RuleTypes+ ( ModSummaryResult(msrModSummary),+ GetModSummary(GetModSummary),+ GhcSessionDeps(GhcSessionDeps),+ GetDependencyInformation(GetDependencyInformation),+ GetLinkable(GetLinkable) )+import Development.IDE.Core.Shake ( VFSModified(VFSUnmodified) )+import Development.IDE.Types.HscEnvEq ( HscEnvEq(hscEnv) )+import qualified Development.IDE.GHC.Compat.Core as Compat+ ( InteractiveImport(IIModule) )+import qualified Development.IDE.GHC.Compat.Core as SrcLoc+ ( unLoc, HasSrcSpan(getLoc) ) #if MIN_VERSION_ghc(9,2,0)-import GHC (Fixity) #endif import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..)) import Development.IDE.Core.FileStore (setSomethingModified) import Development.IDE.Types.Shake (toKey)-#if MIN_VERSION_ghc(9,2,0)+#if MIN_VERSION_ghc(9,0,0) import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive)) #endif import Ide.Plugin.Eval.Code (Statement, asStatements,- evalSetup, myExecStmt, propSetup, resultRange,@@ -137,16 +134,6 @@ import Language.LSP.Types.Lens (end, line) import Language.LSP.VFS (virtualFileText) -#if MIN_VERSION_ghc(9,2,0)-#elif MIN_VERSION_ghc(9,0,0)-import GHC.Driver.Session (unitDatabases,- unitState)-import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))-#else-import DynFlags-#endif-- {- | Code Lens provider NOTE: Invoked every time the document is modified, not just when the document is saved. -}@@ -230,112 +217,22 @@ let nfp = toNormalizedFilePath' fp mdlText <- moduleText _uri - -- enable codegen+ -- enable codegen for the module which we need to evaluate. liftIO $ queueForEvaluation st nfp liftIO $ setSomethingModified VFSUnmodified st [toKey NeedsCompilation nfp] "Eval"-- session <- runGetSession st nfp-- ms <- fmap msrModSummary $- liftIO $- runAction "runEvalCmd.getModSummary" st $- use_ GetModSummary nfp-- now <- liftIO getCurrentTime-- let modName = moduleName $ ms_mod ms- thisModuleTarget =- Target- (TargetFile fp Nothing)- False- (Just (textToStringBuffer mdlText, now))-- -- Setup environment for evaluation- hscEnv' <- ExceptT $ fmap join $ liftIO . gStrictTry . evalGhcEnv session $ do- env <- getSession-- -- Install the module pragmas and options- df <- liftIO $ setupDynFlagsForGHCiLike env $ ms_hspp_opts ms-- -- Restore the original import paths- let impPaths = importPaths $ hsc_dflags env- df <- return df{importPaths = impPaths}-- -- Set the modified flags in the session- _lp <- setSessionDynFlags df-- -- property tests need QuickCheck- when (needsQuickCheck tests) $ void $ addPackages ["QuickCheck"]- dbg "QUICKCHECK NEEDS" $ needsQuickCheck tests- dbg "QUICKCHECK HAS" $ hasQuickCheck df-- -- copy the package state to the interactive DynFlags- idflags <- getInteractiveDynFlags- df <- getSessionDynFlags- -- set the identical DynFlags as GHCi- -- Source: https://github.com/ghc/ghc/blob/5abf59976c7335df760e5d8609d9488489478173/ghc/GHCi/UI.hs#L473-L483- -- This needs to be done manually since the default flags are not visible externally.- let df' = flip xopt_set LangExt.ExtendedDefaultRules- . flip xopt_unset LangExt.MonomorphismRestriction- $ idflags- setInteractiveDynFlags $ df'-#if MIN_VERSION_ghc(9,0,0)- {- packageFlags =- packageFlags- df- , useColor = Never- , canUseColor = False- }-#else- { pkgState =- pkgState- df- , pkgDatabase =- pkgDatabase- df- , packageFlags =- packageFlags- df- , useColor = Never- , canUseColor = False- }-#endif-- -- Load the module with its current content (as the saved module might not be up to date)- eSetTarget <- gStrictTry $ setTargets [thisModuleTarget]- dbg "setTarget" eSetTarget+ -- Setup a session with linkables for all dependencies and GHCi specific options+ final_hscEnv <- liftIO $ initialiseSessionForEval+ (needsQuickCheck tests)+ st nfp - -- load the module in the interactive environment- loadResult <- perf "loadModule" $ load LoadAllTargets- dbg "LOAD RESULT" $ printOutputable loadResult- case loadResult of- Failed -> liftIO $ do- let err = ""- dbg "load ERR" err- return $ Left err- Succeeded -> do- -- Evaluation takes place 'inside' the module- setContext [Compat.IIModule modName]- Right <$> getSession evalCfg <- liftIO $ runAction "eval: config" st $ getEvalConfig plId - -- Get linkables for all modules below us- -- This can be optimised to only get the linkables for the symbols depended on by- -- the statement we are parsing- lbs <- liftIO $ runAction "eval: GetLinkables" st $ do- linkables_needed <- reachableModules <$> use_ GetDependencyInformation nfp- uses_ GetLinkable (filter (/= nfp) linkables_needed) -- We don't need the linkable for the current module- let hscEnv'' = hscEnv' { hsc_HPT = addListToHpt (hsc_HPT hscEnv') [(moduleName $ mi_module $ hm_iface hm, hm) | lb <- lbs, let hm = linkableHomeMod lb] }-+ -- Perform the evaluation of the command edits <- perf "edits" $ liftIO $- evalGhcEnv hscEnv'' $- runTests- evalCfg- (st, fp)- tests+ evalGhcEnv final_hscEnv $ do+ runTests evalCfg (st, fp) tests let workspaceEditsMap = HashMap.fromList [(_uri, List $ addFinalReturn mdlText edits)] let workspaceEdits = WorkspaceEdit (Just workspaceEditsMap) Nothing Nothing@@ -345,6 +242,50 @@ withIndefiniteProgress "Evaluating" Cancellable $ response' cmd +-- | Create an HscEnv which is suitable for performing interactive evaluation.+-- All necessary home modules will have linkables and the current module will+-- also be loaded into the environment.+--+-- The interactive context and interactive dynamic flags are also set appropiately.+initialiseSessionForEval :: Bool -> IdeState -> NormalizedFilePath -> IO HscEnv+initialiseSessionForEval needs_quickcheck st nfp = do+ (ms, env1) <- runAction "runEvalCmd" st $ do++ ms <- msrModSummary <$> use_ GetModSummary nfp+ deps_hsc <- hscEnv <$> use_ GhcSessionDeps nfp++ linkables_needed <- reachableModules <$> use_ GetDependencyInformation nfp+ linkables <- uses_ GetLinkable linkables_needed+ -- We unset the global rdr env in mi_globals when we generate interfaces+ -- See Note [Clearing mi_globals after generating an iface]+ -- However, the eval plugin (setContext specifically) requires the rdr_env+ -- for the current module - so get it from the Typechecked Module and add+ -- it back to the iface for the current module.+ rdr_env <- tcg_rdr_env . tmrTypechecked <$> use_ TypeCheck nfp+ let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc+ addRdrEnv hmi+ | iface <- hm_iface hmi+ , ms_mod ms == mi_module iface+ = hmi { hm_iface = iface { mi_globals = Just rdr_env } }+ | otherwise = hmi++ return (ms, linkable_hsc)+ -- Bit awkward we need to use evalGhcEnv here but setContext requires to run+ -- in the Ghc monad+ env2 <- evalGhcEnv env1 $ do+ setContext [Compat.IIModule (moduleName (ms_mod ms))]+ let df = flip xopt_set LangExt.ExtendedDefaultRules+ . flip xopt_unset LangExt.MonomorphismRestriction+ . flip gopt_set Opt_ImplicitImportQualified+ . flip gopt_unset Opt_DiagnosticsShowCaret+ $ (ms_hspp_opts ms) {+ useColor = Never+ , canUseColor = False }+ modifyDynFlags (const df)+ when needs_quickcheck $ void $ addPackages ["QuickCheck"]+ getSession+ return env2+ addFinalReturn :: Text -> [TextEdit] -> [TextEdit] addFinalReturn mdlText edits | not (null edits) && not (T.null mdlText) && T.last mdlText /= '\n' =@@ -374,6 +315,12 @@ ] type TEnv = (IdeState, String)+-- |GHC declarations required for expression evaluation+evalSetup :: Ghc ()+evalSetup = do+ preludeAsP <- parseImportDecl "import qualified Prelude as P"+ context <- getContext+ setContext (IIDecl preludeAsP : context) runTests :: EvalConfig -> TEnv -> [(Section, Test)] -> Ghc [TextEdit] runTests EvalConfig{..} e@(_st, _) tests = do@@ -387,7 +334,6 @@ processTest e@(st, fp) df (section, test) = do let dbg = logWith st let pad = pad_ $ (if isLiterate fp then ("> " `T.append`) else id) $ padPrefix (sectionFormat section)- rs <- runTest e df test dbg "TEST RESULTS" rs @@ -560,22 +506,6 @@ T.unpack (printOutputable $ SrcLoc.getLoc warnMsg) <> ": warning:\n" <> " " <> SrcLoc.unLoc warnMsg -runGetSession :: MonadIO m => IdeState -> NormalizedFilePath -> m HscEnv-runGetSession st nfp = liftIO $ runAction "eval" st $ do- -- Create a new GHC Session rather than reusing an existing one- -- to avoid interfering with ghcide- -- UPDATE: I suspect that this doesn't really work, we always get the same Session- -- we probably cache hscEnvs in the Session state- IdeGhcSession{loadSessionFun} <- useNoFile_ GhcSessionIO- let fp = fromNormalizedFilePath nfp- ((_, res),_) <- liftIO $ loadSessionFun fp- let env = fromMaybe (error $ "Unknown file: " <> fp) res- ghcSessionDepsConfig = def- { checkForImportCycles = False- }- res <- fmap hscEnvWithImportPaths <$> ghcSessionDepsDefinition True ghcSessionDepsConfig env nfp- return $ fromMaybe (error $ "Unable to load file: " <> fp) res- needsQuickCheck :: [(Section, Test)] -> Bool needsQuickCheck = any (isProperty . snd) @@ -659,7 +589,7 @@ names <- GHC.parseName str mb_stuffs <- mapM (GHC.getInfo allInfo) names let filtered = filterOutChildren (\(t,_f,_ci,_fi,_sd) -> t)- (catMaybes mb_stuffs)+ (catMaybes $ toList mb_stuffs) return $ vcat (intersperse (text "") $ map pprInfo filtered) filterOutChildren :: (a -> TyThing) -> [a] -> [a]@@ -698,20 +628,20 @@ doKindCmd False df arg = do let input = T.strip arg (_, kind) <- typeKind False $ T.unpack input- let kindText = text (T.unpack input) <+> "::" <+> pprTypeForUser kind+ let kindText = text (T.unpack input) <+> "::" <+> pprSigmaType kind pure $ Just $ T.pack (showSDoc df kindText) doKindCmd True df arg = do let input = T.strip arg (ty, kind) <- typeKind True $ T.unpack input- let kindDoc = text (T.unpack input) <+> "::" <+> pprTypeForUser kind- tyDoc = "=" <+> pprTypeForUser ty+ let kindDoc = text (T.unpack input) <+> "::" <+> pprSigmaType kind+ tyDoc = "=" <+> pprSigmaType ty pure $ Just $ T.pack (showSDoc df $ kindDoc $$ tyDoc) doTypeCmd :: DynFlags -> Text -> Ghc (Maybe Text) doTypeCmd dflags arg = do let (emod, expr) = parseExprMode arg ty <- GHC.exprType emod $ T.unpack expr- let rawType = T.strip $ T.pack $ showSDoc dflags $ pprTypeForUser ty+ let rawType = T.strip $ T.pack $ showSDoc dflags $ pprSigmaType ty broken = T.any (\c -> c == '\r' || c == '\n') rawType pure $ Just $@@ -720,7 +650,7 @@ T.pack $ showSDoc dflags $ text (T.unpack expr)- $$ nest 2 ("::" <+> pprTypeForUser ty)+ $$ nest 2 ("::" <+> pprSigmaType ty) else expr <> " :: " <> rawType <> "\n" parseExprMode :: Text -> (TcRnExprMode, T.Text)@@ -756,22 +686,3 @@ (':', rest) <- T.uncons $ T.stripStart input pure $ second T.strip $ T.break isSpace rest -setupDynFlagsForGHCiLike :: HscEnv -> DynFlags -> IO DynFlags-setupDynFlagsForGHCiLike env dflags = do- let dflags3 = setInterpreterLinkerOptions dflags- platform = targetPlatform dflags3- evalWays = Compat.hostFullWays- dflags3a = setWays evalWays dflags3- dflags3b =- foldl gopt_set dflags3a $- concatMap (Compat.wayGeneralFlags platform) evalWays- dflags3c =- foldl gopt_unset dflags3b $- concatMap (Compat.wayUnsetGeneralFlags platform) evalWays- dflags4 =- dflags3c- `gopt_set` Opt_ImplicitImportQualified- `gopt_set` Opt_IgnoreOptimChanges- `gopt_set` Opt_IgnoreHpcChanges- `gopt_unset` Opt_DiagnosticsShowCaret- Compat.hsc_dflags <$> Compat.initializePlugins (Compat.hscSetFlags dflags4 env)
src/Ide/Plugin/Eval/Rules.hs view
@@ -67,8 +67,13 @@ modifyIORef var (Set.insert nfp) #if MIN_VERSION_ghc(9,2,0)+#if MIN_VERSION_ghc(9,5,0)+getAnnotations :: Development.IDE.GHC.Compat.Located (HsModule GhcPs) -> [LEpaComment]+getAnnotations (L _ m@(HsModule { hsmodExt = XModulePs {hsmodAnn = anns'}})) =+#else getAnnotations :: Development.IDE.GHC.Compat.Located HsModule -> [LEpaComment] getAnnotations (L _ m@(HsModule { hsmodAnn = anns'})) =+#endif priorComments annComments <> getFollowingComments annComments <> concatMap getCommentsForDecl (hsmodImports m) <> concatMap getCommentsForDecl (hsmodDecls m)
src/Ide/Plugin/Eval/Util.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans -Wno-unused-imports #-} -- |Debug utilities module Ide.Plugin.Eval.Util (@@ -11,7 +13,7 @@ logWith, ) where -import Control.Exception (SomeException, evaluate)+import Control.Exception (SomeException, evaluate, fromException) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson (Value (Null))@@ -19,7 +21,8 @@ import qualified Data.Text as T import Development.IDE (IdeState, Priority (..), ideLogger, logPriority)-import Development.IDE.GHC.Compat.Util (MonadCatch, catch)+import Development.IDE.GHC.Compat.Util (MonadCatch, catch, bagToList)+import Development.IDE.GHC.Compat.Outputable import GHC.Exts (toList) import GHC.Stack (HasCallStack, callStack, srcLocFile, srcLocStartCol,@@ -36,7 +39,7 @@ _ <- out name (showDuration secs) return r --- |Log using hie logger, reports source position of logging statement+-- | Log using hie logger, reports source position of logging statement logWith :: (HasCallStack, MonadIO m, Show a1, Show a2) => IdeState -> a1 -> a2 -> m () logWith state key val = liftIO . logPriority (ideLogger state) logLevel $@@ -79,4 +82,22 @@ gevaluate = liftIO . evaluate showErr :: Monad m => SomeException -> m (Either String b)-showErr = return . Left . show+showErr e =+#if MIN_VERSION_ghc(9,3,0)+ case fromException e of+ -- On GHC 9.4+, the show instance adds the error message span+ -- We don't want this for the plugin+ -- So render without the span.+ Just (SourceError msgs) -> return $ Left $ renderWithContext defaultSDocContext+ $ vcat+ $ bagToList+ $ fmap (vcat . unDecorated+ . diagnosticMessage+#if MIN_VERSION_ghc(9,5,0)+ (defaultDiagnosticOpts @GhcMessage)+#endif+ . errMsgDiagnostic)+ $ getMessages msgs+ _ ->+#endif+ return . Left . show $ e
test/Main.hs view
@@ -22,6 +22,7 @@ import qualified Ide.Plugin.Eval as Eval import Ide.Plugin.Eval.Types (EvalParams (..), Section (..), testOutput)+import Ide.Types (IdePlugins (IdePlugins)) import Language.LSP.Types.Lens (arguments, command, range, title) import System.FilePath ((</>)) import Test.Hls@@ -73,29 +74,34 @@ evalInFile "T8.hs" "-- >>> noFunctionWithThisName" "-- Variable not in scope: noFunctionWithThisName" evalInFile "T8.hs" "-- >>> res = \"a\" + \"bc\"" $ if- | ghcVersion == GHC92 -> "-- 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\""+ | ghcVersion >= GHC96 -> "-- 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\""+ | ghcVersion >= GHC92 -> "-- 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\"" | ghcVersion == GHC90 -> "-- No instance for (Num String) arising from a use of ‘+’" | otherwise -> "-- No instance for (Num [Char]) arising from a use of ‘+’" 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 == 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" (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 "Returns a fully-instantiated type for :type" "T14" "hs"- , knownBrokenForGhcVersions [GHC92] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs"+ , knownBrokenForGhcVersions [GHC92, GHC94, GHC96] "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" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , 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" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , testCase ":type handles a multilined result properly" $ evalInFile "T21.hs" "-- >>> :type fun" $ T.unlines [ "-- fun", if- | ghcVersion == GHC92 -> "-- :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)."+ | ghcVersion >= GHC92 -> "-- :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)." | ghcVersion == GHC90 -> "-- :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}." | otherwise -> "-- :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).", "-- (KnownNat k2, KnownNat n, Typeable a) =>",@@ -105,7 +111,7 @@ , testCase ":type does \"dovetails\" for short identifiers" $ evalInFile "T23.hs" "-- >>> :type f" $ T.unlines [ if- | ghcVersion == GHC92 -> "-- f :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)."+ | ghcVersion >= GHC92 -> "-- f :: forall {k1} (k2 :: Nat) (n :: Nat) (a :: k1)." | ghcVersion == GHC90 -> "-- f :: forall {k1} {k2 :: Nat} {n :: Nat} {a :: k1}." | otherwise -> "-- f :: forall k1 (k2 :: Nat) (n :: Nat) (a :: k1).", "-- (KnownNat k2, KnownNat n, Typeable a) =>",@@ -124,17 +130,26 @@ , goldenWithEval "Transitive local dependency" "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 == GHC92 then "ghc92.expected" else "expected")+ , goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion >= GHC92 then "ghc92.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+ (if ghcVersion >= GHC92 then "-- id :: forall a. a -> a" else "-- 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" , goldenWithEval "Property checking" "TProperty" "hs"- , goldenWithEval "Property checking with exception" "TPropertyError" "hs"+ , goldenWithEval' "Property checking with exception" "TPropertyError" "hs" (+ if ghcVersion >= GHC96 then+ "ghc96.expected"+ else if ghcVersion >= GHC94 && hostOS == Windows then+ "windows-ghc94.expected"+ else if ghcVersion >= GHC94 then+ "ghc94.expected"+ else+ "expected"+ ) , goldenWithEval "Prelude has no special treatment, it is imported as stated in the module" "TPrelude" "hs" , goldenWithEval "Don't panic on {-# UNPACK #-} pragma" "TUNPACK" "hs" , goldenWithEval "Can handle eval inside nested comment properly" "TNested" "hs"
test/testdata/T11.expected.hs view
@@ -1,4 +1,4 @@ module T11 where --- >>> :kind! a--- Not in scope: type variable ‘a’+-- >>> :kind! A+-- Not in scope: type constructor or class ‘A’
− test/testdata/T11.ghc92.expected.hs
@@ -1,4 +0,0 @@-module T11 where---- >>> :kind! a--- Not in scope: type variable `a'
− test/testdata/T11.ghc92_expected.hs
@@ -1,4 +0,0 @@-module T11 where---- >>> :kind! a--- Not in scope: type variable `a'
test/testdata/T11.hs view
@@ -1,3 +1,3 @@ module T11 where --- >>> :kind! a+-- >>> :kind! A
test/testdata/T13.expected.hs view
@@ -1,4 +1,4 @@ module T13 where --- >>> :kind a--- Not in scope: type variable ‘a’+-- >>> :kind A+-- Not in scope: type constructor or class ‘A’
test/testdata/T13.ghc92.expected.hs view
@@ -1,4 +1,4 @@ module T13 where --- >>> :kind a--- Not in scope: type variable `a'+-- >>> :kind A+-- Not in scope: type constructor or class `A'
test/testdata/T13.hs view
@@ -1,3 +1,3 @@ module T13 where --- >>> :kind a+-- >>> :kind A
+ test/testdata/TPropertyError.ghc94.expected.hs view
@@ -0,0 +1,13 @@+-- Support for property checking+module TProperty where++-- prop> \(l::[Bool]) -> head l+-- *** Failed! (after 1 test):+-- Exception:+-- Prelude.head: empty list+-- CallStack (from HasCallStack):+-- error, called at libraries/base/GHC/List.hs:1646:3 in base:GHC.List+-- errorEmptyList, called at libraries/base/GHC/List.hs:85:11 in base:GHC.List+-- badHead, called at libraries/base/GHC/List.hs:81:28 in base:GHC.List+-- head, called at <interactive>:1:27 in interactive:Ghci2+-- []
+ test/testdata/TPropertyError.windows-ghc94.expected.hs view
@@ -0,0 +1,13 @@+-- Support for property checking+module TProperty where++-- prop> \(l::[Bool]) -> head l+-- *** Failed! (after 1 test):+-- Exception:+-- Prelude.head: empty list+-- CallStack (from HasCallStack):+-- error, called at libraries\base\GHC\List.hs:1646:3 in base:GHC.List+-- errorEmptyList, called at libraries\base\GHC\List.hs:85:11 in base:GHC.List+-- badHead, called at libraries\base\GHC\List.hs:81:28 in base:GHC.List+-- head, called at <interactive>:1:27 in interactive:Ghci2+-- []