diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Revision history for haskell-debugger +## 0.13.1.0 -- 2026-04-28 + +* Fix critical bug which caused certain breakpoints to be overwritten by or + confused with breakpoints from separate modules. +* Fix: Make forcing a thunk invalidate all threads + ## 0.13.0.0 -- 2026-04-24 Features: diff --git a/haskell-debugger.cabal b/haskell-debugger.cabal --- a/haskell-debugger.cabal +++ b/haskell-debugger.cabal @@ -1,6 +1,6 @@ cabal-version: 3.12 name: haskell-debugger -version: 0.13.0.0 +version: 0.13.1.0 synopsis: A step-through debugger for GHC Haskell @@ -243,7 +243,8 @@ Test.Integration.Stdout, Test.Integration.Conditional, Test.Integration.Evaluate, - Test.Integration.StackTrace + Test.Integration.StackTrace, + Test.Integration.SelfDebug build-depends: base >=4.14, async, diff --git a/haskell-debugger/GHC/Debugger/Breakpoint.hs b/haskell-debugger/GHC/Debugger/Breakpoint.hs --- a/haskell-debugger/GHC/Debugger/Breakpoint.hs +++ b/haskell-debugger/GHC/Debugger/Breakpoint.hs @@ -33,6 +33,7 @@ import GHC.Debugger.Utils import GHC.Debugger.Interface.Messages import qualified GHC.Debugger.Breakpoint.Map as BM +import Data.Function -------------------------------------------------------------------------------- -- * Breakpoints @@ -192,14 +193,14 @@ mms <- getModuleByPath file case mms of Right ms -> do - hsc_env <- getSession - imodBreaks <- liftIO $ expectJust <$> readIModBreaksMaybe (hsc_HUG hsc_env) (ms_mod ms) - return - [ ibi - | ibi <- BM.keys bm - , getBreakSourceMod ibi imodBreaks == ms_mod ms - -- assert: status is always > disabled - ] + hug <- hsc_HUG <$> getSession + -- Return all active IBIs whose occurrence (source) module + -- matches the argument source module. + map fst <$> filterM (\(ibi, info) -> do + ibi_occ_mod <- getBreakSourceMod ibi <$> readIModBreaks hug ibi & liftIO + assert (bpInfoStatus info /= BreakpointDisabled) $ + return (ibi_occ_mod == ms_mod ms) + ) (BM.toList bm) Left e -> do logSDoc Logger.Warning e return [] diff --git a/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs b/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs --- a/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs +++ b/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs @@ -17,6 +17,8 @@ import GHC.ByteCode.Breakpoints import GHC.Utils.Outputable (Outputable) import qualified Data.IntMap as IM +import GHC.Debugger.View.Class +import GHC.Debugger.Utils (showModule) -- | A map keyed by 'InternalBreakpointId' newtype BreakpointMap a = BreakpointMap (ModuleEnv (IM.IntMap a)) @@ -77,3 +79,10 @@ | (m, im) <- moduleEnvToList bm , (bix, a) <- IM.toList im ] + +instance DebugView (BreakpointMap a) where + debugValue (BreakpointMap b) = simpleValue "BreakpointMap" (not $ isEmptyModuleEnv b) + debugFields bm = pure $ VarFields + [ (showModule ibi_info_mod ++ "(" ++ show ibi_info_index ++ ")", VarFieldValue v) + | (InternalBreakpointId{ibi_info_mod, ibi_info_index}, v) <- toList bm + ] diff --git a/haskell-debugger/GHC/Debugger/Session/Builtin.hs b/haskell-debugger/GHC/Debugger/Session/Builtin.hs --- a/haskell-debugger/GHC/Debugger/Session/Builtin.hs +++ b/haskell-debugger/GHC/Debugger/Session/Builtin.hs @@ -147,16 +147,16 @@ -- | The contents of GHC.Debugger.View.Class in memory debuggerViewClassContents :: StringBuffer -debuggerViewClassContents = stringToStringBuffer $(embedStringFile "haskell-debugger-view/src/GHC/Debugger/View/Class.hs") +debuggerViewClassContents = stringToStringBuffer $(embedStringFile =<< makeRelativeToProject "haskell-debugger-view/src/GHC/Debugger/View/Class.hs") -- | The contents of GHC.Debugger.View.Containers in memory debuggerViewContainersContents :: StringBuffer -debuggerViewContainersContents = stringToStringBuffer $(embedStringFile "haskell-debugger-view/src/GHC/Debugger/View/Containers.hs") +debuggerViewContainersContents = stringToStringBuffer $(embedStringFile =<< makeRelativeToProject "haskell-debugger-view/src/GHC/Debugger/View/Containers.hs") -- | GHC.Debugger.View.Text debuggerViewTextContents :: StringBuffer -debuggerViewTextContents = stringToStringBuffer $(embedStringFile "haskell-debugger-view/src/GHC/Debugger/View/Text.hs") +debuggerViewTextContents = stringToStringBuffer $(embedStringFile =<< makeRelativeToProject "haskell-debugger-view/src/GHC/Debugger/View/Text.hs") -- | GHC.Debugger.View.ByteString debuggerViewByteStringContents :: StringBuffer -debuggerViewByteStringContents = stringToStringBuffer $(embedStringFile "haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs") +debuggerViewByteStringContents = stringToStringBuffer $(embedStringFile =<< makeRelativeToProject "haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs") diff --git a/haskell-debugger/GHC/Debugger/Utils.hs b/haskell-debugger/GHC/Debugger/Utils.hs --- a/haskell-debugger/GHC/Debugger/Utils.hs +++ b/haskell-debugger/GHC/Debugger/Utils.hs @@ -105,3 +105,9 @@ num :: Parser Int num = decimal +-------------------------------------------------------------------------------- +-- * DebugView utils +-------------------------------------------------------------------------------- + +showModule :: Module -> String +showModule = showSDocUnsafe . withPprStyle (PprDump alwaysQualify) . ppr diff --git a/haskell-debugger/GHC/Debugger/Utils/Orphans.hs b/haskell-debugger/GHC/Debugger/Utils/Orphans.hs --- a/haskell-debugger/GHC/Debugger/Utils/Orphans.hs +++ b/haskell-debugger/GHC/Debugger/Utils/Orphans.hs @@ -1,9 +1,22 @@ {-# OPTIONS_GHC -Wno-orphans #-} -module GHC.Debugger.Utils.Orphans where +module GHC.Debugger.Utils.Orphans () where import GHC.Debugger.View.Class import GHC.Data.FastString +import GHC.Unit.Module +import GHC.Debugger.Utils (showModule) instance DebugView FastString where debugValue t = simpleValue (unpackFS t) False debugFields _ = pure (VarFields []) + +instance DebugView Module where + debugValue t = simpleValue (showModule t) False + debugFields _ = pure (VarFields []) + +instance DebugView (ModuleEnv a) where + debugValue m = simpleValue "ModuleEnv" (not $ isEmptyModuleEnv m) + debugFields m = pure $ VarFields + [ (showModule k, VarFieldValue v) + | (k, v) <- moduleEnvToList m + ] diff --git a/hdb/Development/Debug/Adapter/Stopped.hs b/hdb/Development/Debug/Adapter/Stopped.hs --- a/hdb/Development/Debug/Adapter/Stopped.hs +++ b/hdb/Development/Debug/Adapter/Stopped.hs @@ -148,7 +148,6 @@ ForcedVariable _ -> sendInvalidatedEvent defaultInvalidatedEvent { invalidatedEventAreas = [InvalidatedAreasVariables] - , invalidatedEventStackFrameId = Just 0 -- TODO: REVERSE LOOKUP OF (StackFrameIx threadId frameIx) } VariableFields _ -> return () diff --git a/test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.ghc-914.hdb-stdout b/test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.ghc-914.hdb-stdout --- a/test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.ghc-914.hdb-stdout +++ b/test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.ghc-914.hdb-stdout @@ -1,55 +1,3 @@ -[ 1 of 53] Compiling Development.Debug.Adapter.Handles ( /hdb/Development/Debug/Adapter/Handles.hs, interpreted )[haskell-debugger--inplace-hdb] -[ 2 of 53] Compiling Development.Debug.Options ( /hdb/Development/Debug/Options.hs, interpreted )[haskell-debugger--inplace-hdb] -[ 3 of 53] Compiling Development.Debug.Session.Setup ( /hdb/Development/Debug/Session/Setup.hs, interpreted )[haskell-debugger--inplace-hdb] -[ 4 of 53] Compiling GHC.Debugger.Breakpoint.Map ( /haskell-debugger/GHC/Debugger/Breakpoint/Map.hs, interpreted )[haskell-debugger--inplace] -[ 5 of 53] Compiling GHC.Debugger.Runtime.Compile.Cache ( /haskell-debugger/GHC/Debugger/Runtime/Compile/Cache.hs, interpreted )[haskell-debugger--inplace] -[ 6 of 53] Compiling GHC.Debugger.Runtime.Term.Key ( /haskell-debugger/GHC/Debugger/Runtime/Term/Key.hs, interpreted )[haskell-debugger--inplace] -[ 7 of 53] Compiling GHC.Debugger.Interface.Messages ( /haskell-debugger/GHC/Debugger/Interface/Messages.hs, interpreted )[haskell-debugger--inplace] -[ 8 of 53] Compiling GHC.Debugger.Runtime.Interpreter.Custom ( /haskell-debugger/GHC/Debugger/Runtime/Interpreter/Custom.hs, interpreted )[haskell-debugger--inplace] -[ 9 of 53] Compiling Development.Debug.Adapter ( /hdb/Development/Debug/Adapter.hs, interpreted )[haskell-debugger--inplace-hdb] -[10 of 53] Compiling Development.Debug.Adapter.Proxy ( /hdb/Development/Debug/Adapter/Proxy.hs, interpreted )[haskell-debugger--inplace-hdb] -[11 of 53] Compiling Development.Debug.Adapter.Output ( /hdb/Development/Debug/Adapter/Output.hs, interpreted )[haskell-debugger--inplace-hdb] -[12 of 53] Compiling Development.Debug.Adapter.Interface ( /hdb/Development/Debug/Adapter/Interface.hs, interpreted )[haskell-debugger--inplace-hdb] -[13 of 53] Compiling Development.Debug.Adapter.Stopped ( /hdb/Development/Debug/Adapter/Stopped.hs, interpreted )[haskell-debugger--inplace-hdb] -[14 of 53] Compiling Development.Debug.Adapter.Exit.Helpers ( /hdb/Development/Debug/Adapter/Exit/Helpers.hs, interpreted )[haskell-debugger--inplace-hdb] -[15 of 53] Compiling Development.Debug.Adapter.Exit ( /hdb/Development/Debug/Adapter/Exit.hs, interpreted )[haskell-debugger--inplace-hdb] -[16 of 53] Compiling Development.Debug.Adapter.ExceptionInfo ( /hdb/Development/Debug/Adapter/ExceptionInfo.hs, interpreted )[haskell-debugger--inplace-hdb] -[17 of 53] Compiling Development.Debug.Adapter.Evaluation ( /hdb/Development/Debug/Adapter/Evaluation.hs, interpreted )[haskell-debugger--inplace-hdb] -[18 of 53] Compiling Development.Debug.Adapter.Stepping ( /hdb/Development/Debug/Adapter/Stepping.hs, interpreted )[haskell-debugger--inplace-hdb] -[19 of 53] Compiling Development.Debug.Adapter.Breakpoints ( /hdb/Development/Debug/Adapter/Breakpoints.hs, interpreted )[haskell-debugger--inplace-hdb] -[20 of 53] Compiling GHC.Debugger.Runtime.Thread.Map ( /haskell-debugger/GHC/Debugger/Runtime/Thread/Map.hs, interpreted )[haskell-debugger--inplace] -[21 of 53] Compiling GHC.Debugger.Session ( /haskell-debugger/GHC/Debugger/Session.hs, interpreted )[haskell-debugger--inplace] -[22 of 53] Compiling GHC.Debugger.Session.Builtin ( /haskell-debugger/GHC/Debugger/Session/Builtin.hs, interpreted )[haskell-debugger--inplace] -[23 of 53] Compiling GHC.Debugger.Session.Interactive ( /haskell-debugger/GHC/Debugger/Session/Interactive.hs, interpreted )[haskell-debugger--inplace] -[24 of 53] Compiling GHC.Debugger.Utils ( /haskell-debugger/GHC/Debugger/Utils.hs, interpreted )[haskell-debugger--inplace] -[25 of 53] Compiling GHC.Debugger.View.Class ( /haskell-debugger-view/src/GHC/Debugger/View/Class.hs, interpreted )[haskell-debugger-view--inplace] -[26 of 53] Compiling GHC.Debugger.View.ByteString ( /haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs, interpreted )[haskell-debugger-view--inplace] -[27 of 53] Compiling GHC.Debugger.Utils.Orphans ( /haskell-debugger/GHC/Debugger/Utils/Orphans.hs, interpreted )[haskell-debugger--inplace] -[28 of 53] Compiling GHC.Debugger.Runtime.Instances.Discover[boot] ( /haskell-debugger/GHC/Debugger/Runtime/Instances/Discover.hs-boot, interpreted )[haskell-debugger--inplace] -[29 of 53] Compiling GHC.Debugger.Monad ( /haskell-debugger/GHC/Debugger/Monad.hs, interpreted )[haskell-debugger--inplace] -[30 of 53] Compiling GHC.Debugger.Runtime.Instances.Discover ( /haskell-debugger/GHC/Debugger/Runtime/Instances/Discover.hs, interpreted )[haskell-debugger--inplace] -[31 of 53] Compiling GHC.Debugger.Runtime.Eval ( /haskell-debugger/GHC/Debugger/Runtime/Eval.hs, interpreted )[haskell-debugger--inplace] -[32 of 53] Compiling GHC.Debugger.Runtime.Compile ( /haskell-debugger/GHC/Debugger/Runtime/Compile.hs, interpreted )[haskell-debugger--inplace] -[33 of 53] Compiling GHC.Debugger.Runtime.Eval.RemoteExpr ( /haskell-debugger/GHC/Debugger/Runtime/Eval/RemoteExpr.hs, interpreted )[haskell-debugger--inplace] -[34 of 53] Compiling GHC.Debugger.Runtime.Term.Parser ( /haskell-debugger/GHC/Debugger/Runtime/Term/Parser.hs, interpreted )[haskell-debugger--inplace] -[35 of 53] Compiling GHC.Debugger.Runtime.Instances ( /haskell-debugger/GHC/Debugger/Runtime/Instances.hs, interpreted )[haskell-debugger--inplace] -[36 of 53] Compiling GHC.Debugger.Runtime.Eval.RemoteExpr.Builtin ( /haskell-debugger/GHC/Debugger/Runtime/Eval/RemoteExpr/Builtin.hs, interpreted )[haskell-debugger--inplace] -[37 of 53] Compiling GHC.Debugger.Runtime.Thread.Stack ( /haskell-debugger/GHC/Debugger/Runtime/Thread/Stack.hs, interpreted )[haskell-debugger--inplace] -[38 of 53] Compiling GHC.Debugger.Runtime.Thread ( /haskell-debugger/GHC/Debugger/Runtime/Thread.hs, interpreted )[haskell-debugger--inplace] -[39 of 53] Compiling GHC.Debugger.Stopped.Exception ( /haskell-debugger/GHC/Debugger/Stopped/Exception.hs, interpreted )[haskell-debugger--inplace] -[40 of 53] Compiling GHC.Debugger.Runtime ( /haskell-debugger/GHC/Debugger/Runtime.hs, interpreted )[haskell-debugger--inplace] -[41 of 53] Compiling GHC.Debugger.Stopped.Variables ( /haskell-debugger/GHC/Debugger/Stopped/Variables.hs, interpreted )[haskell-debugger--inplace] -[42 of 53] Compiling GHC.Debugger.Stopped ( /haskell-debugger/GHC/Debugger/Stopped.hs, interpreted )[haskell-debugger--inplace] -[43 of 53] Compiling GHC.Debugger.Run ( /haskell-debugger/GHC/Debugger/Run.hs, interpreted )[haskell-debugger--inplace] -[44 of 53] Compiling GHC.Debugger.Breakpoint ( /haskell-debugger/GHC/Debugger/Breakpoint.hs, interpreted )[haskell-debugger--inplace] -[45 of 53] Compiling GHC.Debugger ( /haskell-debugger/GHC/Debugger.hs, interpreted )[haskell-debugger--inplace] -[46 of 53] Compiling Development.Debug.Interactive ( /hdb/Development/Debug/Interactive.hs, interpreted )[haskell-debugger--inplace-hdb] -[47 of 53] Compiling Development.Debug.Adapter.Init ( /hdb/Development/Debug/Adapter/Init.hs, interpreted )[haskell-debugger--inplace-hdb] -[48 of 53] Compiling GHC.Debugger.View.Containers ( /haskell-debugger-view/src/GHC/Debugger/View/Containers.hs, interpreted )[haskell-debugger-view--inplace] -[49 of 53] Compiling GHC.Debugger.View.Text ( /haskell-debugger-view/src/GHC/Debugger/View/Text.hs, interpreted )[haskell-debugger-view--inplace] -[50 of 53] Compiling Paths_haskell_debugger ( /Paths_haskell_debugger.hs, interpreted )[haskell-debugger--inplace-hdb] -[51 of 53] Compiling Development.Debug.Options.Parser ( /hdb/Development/Debug/Options/Parser.hs, interpreted )[haskell-debugger--inplace-hdb] -[52 of 53] Compiling Main ( /hdb/Main.hs, interpreted )[haskell-debugger--inplace-hdb] (hdb) Stopped at breakpoint (hdb) this FastString should be displayed pretty as a string (SHOULD NOT SEE ITS FULL INTERNALS). (hdb) We have a DebugView FastString instance at this breakpoint. diff --git a/test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.hdb-test b/test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.hdb-test --- a/test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.hdb-test +++ b/test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.hdb-test @@ -9,6 +9,9 @@ # too prone to changing because it reports source lines of the actual debugger # source, which we change all the time (unlike testsuite programs). # +# 3.1) Grep out all `[27 of 53] Compiling ...` lines. Everytime we added a +# module it would force the test to be updated and was prone to conflicts. +# # 4) Normalize cabal autogen paths (e.g. `Paths_haskell_debugger.hs`). # It's not immediately clear why these go in .cache/hie-bios/... rather than in # $HDB_CACHE_DIR, but I guess it's an autogen thing rather than the actual @@ -24,6 +27,7 @@ $HDB -v0 hdb/Main.hs < "test/golden/self-debug-cli/self-debug-cli.hdb-stdin" 2>&1 \ | grep -v "BreakFound" \ + | grep -v "] Compiling" \ | sed \ -e 's|[^ ]*/Paths_haskell_debugger.hs|/Paths_haskell_debugger.hs|g' \ -e 's|haskell-debugger-[0-9.][0-9.]*-inplace|haskell-debugger--inplace|g' \ diff --git a/test/golden/standalone-multi-module/Helper.hs b/test/golden/standalone-multi-module/Helper.hs new file mode 100644 --- /dev/null +++ b/test/golden/standalone-multi-module/Helper.hs @@ -0,0 +1,5 @@ +module Helper where + +greet :: String -> IO () +greet name = do + putStrLn ("Hello, " ++ name ++ "!") diff --git a/test/golden/standalone-multi-module/Main.hs b/test/golden/standalone-multi-module/Main.hs new file mode 100644 --- /dev/null +++ b/test/golden/standalone-multi-module/Main.hs @@ -0,0 +1,9 @@ +module Main where + +import Helper + +main :: IO () +main = do + putStrLn "Starting..." + greet "world" + putStrLn "Done." diff --git a/test/golden/standalone-multi-module/standalone-multi-module.ghc-914.hdb-stdout b/test/golden/standalone-multi-module/standalone-multi-module.ghc-914.hdb-stdout new file mode 100644 --- /dev/null +++ b/test/golden/standalone-multi-module/standalone-multi-module.ghc-914.hdb-stdout @@ -0,0 +1,9 @@ +[1 of 4] Compiling GHC.Debugger.View.Class ( in-memory:GHC.Debugger.View.Class, interpreted )[haskell-debugger-view-in-memory] +[2 of 4] Compiling Helper ( /Helper.hs, interpreted )[main] +[3 of 4] Compiling Main ( /Main.hs, interpreted )[main] +(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Main 5], sourceSpan = SourceSpan {file = "/Main.hs", startLine = 7, endLine = 7, startCol = 3, endCol = 25}} +(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Helper 4], sourceSpan = SourceSpan {file = "/./Helper.hs", startLine = 5, endLine = 5, startCol = 3, endCol = 38}} +(hdb) Stopped at breakpoint +(hdb) Starting... +Stopped at breakpoint +(hdb) Exiting... diff --git a/test/golden/standalone-multi-module/standalone-multi-module.hdb-stdin b/test/golden/standalone-multi-module/standalone-multi-module.hdb-stdin new file mode 100644 --- /dev/null +++ b/test/golden/standalone-multi-module/standalone-multi-module.hdb-stdin @@ -0,0 +1,4 @@ +break Main.hs 7 +break Helper.hs 5 +run +continue diff --git a/test/golden/standalone-multi-module/standalone-multi-module.hdb-test b/test/golden/standalone-multi-module/standalone-multi-module.hdb-test new file mode 100644 --- /dev/null +++ b/test/golden/standalone-multi-module/standalone-multi-module.hdb-test @@ -0,0 +1,1 @@ +$HDB Main.hs -v 0 < standalone-multi-module.hdb-stdin diff --git a/test/haskell/Main.hs b/test/haskell/Main.hs --- a/test/haskell/Main.hs +++ b/test/haskell/Main.hs @@ -38,6 +38,7 @@ import Test.Integration.Conditional (conditionalTests) import Test.Integration.Evaluate (evaluateTests) import Test.Integration.StackTrace (stackTraceTests) +import Test.Integration.SelfDebug (selfDebugTests) import Test.Utils import qualified Data.Char as C import qualified Data.Text as T @@ -102,6 +103,7 @@ , conditionalTests , evaluateTests , stackTraceTests + , selfDebugTests ] -- | Receives as an argument the path to the @*.hdb-test@ which contains the diff --git a/test/haskell/Test/Integration/Basic.hs b/test/haskell/Test/Integration/Basic.hs --- a/test/haskell/Test/Integration/Basic.hs +++ b/test/haskell/Test/Integration/Basic.hs @@ -27,6 +27,10 @@ , testCase "accepts internalInterpreter launch option" internalInterpreterOption ] ] + , testGroup "Multi-module standalone (no cabal/hie.yaml)" + [ testCase "breakpoints in two modules (#297)" multiModuleStandaloneBreakpoints + , testCase "breakpoints in two modules (flipped) (#297)" multiModuleStandaloneBreakpoints2 + ] ] basicForConfig :: TestName -> FilePath -> FilePath -> TestTree @@ -88,4 +92,38 @@ let cfg = (mkLaunchConfig test_dir "Main.hs") { lcInternalInterpreter = Just True } -- TODO: Automatically run all tests with internal interpreter too? hitBreakpointWith cfg 6 + disconnect + +-- | Two-module standalone project (no cabal, no hie.yaml): set a breakpoint in +-- each module, run, hit the first (Main.hs), continue, hit the second (Helper.hs). +-- (#297) +multiModuleStandaloneBreakpoints :: Assertion +multiModuleStandaloneBreakpoints = + withTestDAPServer "test/integration/standalone-multi-module" [] $ \test_dir server -> + withTestDAPServerClient server $ do + let cfg = mkLaunchConfig test_dir "Main.hs" + _ <- sync $ launchWith cfg + waitFiltering_ EventTy "initialized" + _ <- sync $ setLineBreakpoints test_dir "Main.hs" [7] + _ <- sync $ setLineBreakpoints test_dir "Helper.hs" [5] + _ <- sync configurationDone + assertStoppedLocation DAP.StoppedEventReasonBreakpoint 7 + continueThread 0 + assertStoppedLocation DAP.StoppedEventReasonBreakpoint 5 + disconnect + +-- | Same as above, but flip the order of the setLineBreakpoints calls (#297) +multiModuleStandaloneBreakpoints2 :: Assertion +multiModuleStandaloneBreakpoints2 = + withTestDAPServer "test/integration/standalone-multi-module" [] $ \test_dir server -> + withTestDAPServerClient server $ do + let cfg = mkLaunchConfig test_dir "Main.hs" + _ <- sync $ launchWith cfg + waitFiltering_ EventTy "initialized" + _ <- sync $ setLineBreakpoints test_dir "Helper.hs" [5] + _ <- sync $ setLineBreakpoints test_dir "Main.hs" [7] + _ <- sync configurationDone + assertStoppedLocation DAP.StoppedEventReasonBreakpoint 7 + continueThread 0 + assertStoppedLocation DAP.StoppedEventReasonBreakpoint 5 disconnect diff --git a/test/haskell/Test/Integration/Evaluate.hs b/test/haskell/Test/Integration/Evaluate.hs --- a/test/haskell/Test/Integration/Evaluate.hs +++ b/test/haskell/Test/Integration/Evaluate.hs @@ -1,15 +1,14 @@ --- | Evaluate request tests (issue #116) ported from the NodeJS testsuite. +-- | Evaluate request tests ported from the NodeJS testsuite. {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Test.Integration.Evaluate (evaluateTests) where import Control.Monad.IO.Class (liftIO) +import Data.List (isInfixOf) import Test.DAP import Test.Tasty import Test.Tasty.HUnit -#ifdef mingw32_HOST_OS import Test.Tasty.ExpectedFailure -#endif import qualified DAP evaluateTests :: TestTree @@ -20,6 +19,11 @@ testGroup "DAP.Integration.Evaluate" [ testCase "Return structured representation for evaluated expressions (issue #116)" evaluateStructured + , testCase "Imported module bindings available in evaluate context (issue #233)" + evaluateImportedBindings + , expectFailBecause "#299" $ + testCase "Bindings from other modules not available in evaluate context (issue #233)" + evaluateImportedBindingsNotInOtherModule ] evaluateStructured :: Assertion @@ -37,4 +41,56 @@ (v1:_) -> v1 @==? "\'b\'" [] -> liftIO $ assertFailure $ "No variable named 1 in evaluation result: " ++ show respChildren + disconnect + +-- | Test that bindings from imported modules are available when evaluating +-- expressions at a breakpoint (issue #233). +evaluateImportedBindings :: Assertion +evaluateImportedBindings = + withTestDAPServer "test/integration/T233" [] $ \test_dir server -> + withTestDAPServerClient server $ do + let cfg = mkLaunchConfig test_dir "T233.hs" + hitBreakpointWith cfg 15 + + -- sort is imported from Data.List + sortResp <- evaluate "show (sort xs)" + liftIO $ assertEqual "sort xs result" "\"[1,1,2,3,4,5,6,9]\"" (DAP.evaluateResponseResult sortResp) + + -- Map is a qualified import + mapResp <- evaluate "show (Map.lookup \"a\" m)" + liftIO $ assertEqual "Map.lookup result" "\"Just 1\"" (DAP.evaluateResponseResult mapResp) + + disconnect + +-- | Test that bindings from modules not imported at the stopped location are +-- NOT available in the evaluate context (issue #233). +evaluateImportedBindingsNotInOtherModule :: Assertion +evaluateImportedBindingsNotInOtherModule = + withTestDAPServer "test/integration/T233" [] $ \test_dir server -> + withTestDAPServerClient server $ do + let cfg = mkLaunchConfig test_dir "T233.hs" + + _ <- sync $ launchWith cfg + waitFiltering_ EventTy "initialized" + -- T233.hs imports Data.Map.Strict as Map; Other.hs does not + _ <- sync $ setLineBreakpoints test_dir "T233.hs" [15] + _ <- sync $ setLineBreakpoints test_dir "Other.hs" [4] + _ <- sync configurationDone + _ <- assertStoppedLocation DAP.StoppedEventReasonBreakpoint 15 + + -- Stopped in T233.hs which imports Data.List and Data.Map.Strict as Map + sortResp <- evaluate "show (sort xs)" + liftIO $ assertEqual "sort xs result" "\"[1,1,2,3,4,5,6,9]\"" (DAP.evaluateResponseResult sortResp) + + -- Resume and stop at breakpoint in Other.hs, which does not import Map + continueThread 0 + _ <- assertStoppedLocation DAP.StoppedEventReasonBreakpoint 4 + + -- Map is not imported in Other.hs; evaluating Map.fromList should fail + mapFailResp <- evaluate "Map.fromList [(1,'a')]" + let result = DAP.evaluateResponseResult mapFailResp + liftIO $ assertBool + ("expected 'not in scope' error for Map.fromList, got: " ++ show result) + ("not in scope" `isInfixOf` show result) + disconnect diff --git a/test/haskell/Test/Integration/SelfDebug.hs b/test/haskell/Test/Integration/SelfDebug.hs new file mode 100644 --- /dev/null +++ b/test/haskell/Test/Integration/SelfDebug.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +module Test.Integration.SelfDebug (selfDebugTests) where + +import System.Directory +import System.FilePath +import Control.Monad +import Control.Monad.IO.Class (liftIO) +import Data.Aeson +import Test.DAP +import Test.DAP.Messages.Parser (Event(..)) +import Test.Tasty +import Test.Tasty.HUnit +import qualified DAP +import DAP.Types (StoppedEvent(..)) +#ifdef mingw32_HOST_OS +import Test.Tasty.ExpectedFailure +#endif + +selfDebugTests :: TestTree +selfDebugTests = +#ifdef mingw32_HOST_OS + ignoreTestBecause "Needs to be fixed for Windows (#199)" $ +#endif + testGroup "DAP.Integration.SelfDebug" + [ testCase "debug the debugger itself via DAP" selfDebugDAPTest + ] + +selfDebugDAPTest :: Assertion +selfDebugDAPTest = do + withTestDAPServer "." [] $ \test_dir server -> do -- Self-debug test copies project root to temp dir + doesFileExist (test_dir "cabal.project") >>= \exists -> + unless exists $ writeFile (test_dir "cabal.project") + "packages: . haskell-debugger-view\nallow-newer: ghc-bignum,containers,time,ghc,base,template-haskell" + doesFileExist (test_dir "hie.yaml") >>= \exists -> + unless exists $ writeFile (test_dir "hie.yaml") + "cradle:\n cabal:\n component: \"all\"" + withTestDAPServerClient server $ do + let cfg = LaunchConfig + { lcProjectRoot = test_dir + , lcEntryFile = Just "hdb/Main.hs" + , lcEntryPoint = Just "main" + , lcEntryArgs = ["cli", "test/golden/self-debug-cli/Main.hs"] + , lcExtraGhcArgs = [] + , lcInternalInterpreter = Nothing + } + + _ <- sync $ launchWith cfg + waitFiltering_ EventTy "initialized" + + _ <- sync $ setFunctionBreakpointsRequest @_ @Value $ object + [ "breakpoints" .= [ object [ "name" .= ("runDebugger" :: String) ] ] ] + + _ <- sync configurationDone + + Event{eventBody = Just StoppedEvent{stoppedEventReason = reason}} + <- waitFiltering EventTy "stopped" + liftIO $ assertEqual "expected breakpoint stop" + reason DAP.StoppedEventReasonBreakpoint + -- fixme: should we reply with StoppedEventReasonFunctionBreakpoint instead? + + disconnect diff --git a/test/integration/T233/Other.hs b/test/integration/T233/Other.hs new file mode 100644 --- /dev/null +++ b/test/integration/T233/Other.hs @@ -0,0 +1,6 @@ +module Other where + +process :: [Int] -> IO () +process xs = do + let n = length xs + print n diff --git a/test/integration/T233/T233.hs b/test/integration/T233/T233.hs new file mode 100644 --- /dev/null +++ b/test/integration/T233/T233.hs @@ -0,0 +1,17 @@ +module Main where + +import Data.List (sort, nub) +import qualified Data.Map.Strict as Map +import Other (process) + +main :: IO () +main = do + let xs = [3, 1, 4, 1, 5, 9, 2, 6] :: [Int] + let m = Map.fromList [("a", 1), ("b", 2)] :: Map.Map String Int + check xs m + process xs + +check :: [Int] -> Map.Map String Int -> IO () +check xs m = do + print xs + print m diff --git a/test/integration/standalone-multi-module/Helper.hs b/test/integration/standalone-multi-module/Helper.hs new file mode 100644 --- /dev/null +++ b/test/integration/standalone-multi-module/Helper.hs @@ -0,0 +1,5 @@ +module Helper where + +greet :: String -> IO () +greet name = do + putStrLn ("Hello, " ++ name ++ "!") diff --git a/test/integration/standalone-multi-module/Main.hs b/test/integration/standalone-multi-module/Main.hs new file mode 100644 --- /dev/null +++ b/test/integration/standalone-multi-module/Main.hs @@ -0,0 +1,9 @@ +module Main where + +import Helper + +main :: IO () +main = do + putStrLn "Starting..." + greet "world" + putStrLn "Done."