diff --git a/haskell-debugger/GHC/Debugger/Breakpoint.hs b/haskell-debugger/GHC/Debugger/Breakpoint.hs index 3023b2dd..ec3001ba 100644 --- a/haskell-debugger/GHC/Debugger/Breakpoint.hs +++ b/haskell-debugger/GHC/Debugger/Breakpoint.hs @@ -33,6 +33,7 @@ import GHC.Debugger.Session 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 @@ getActiveBreakpoints mfile = do 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 index b9b88482..3c0aae77 100644 --- a/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs +++ b/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs @@ -17,6 +17,8 @@ import GHC.Unit.Module.Env 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 @@ toList (BreakpointMap bm) = | (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/Utils.hs b/haskell-debugger/GHC/Debugger/Utils.hs index f2ad9fbb..ad521668 100644 --- a/haskell-debugger/GHC/Debugger/Utils.hs +++ b/haskell-debugger/GHC/Debugger/Utils.hs @@ -105,3 +105,9 @@ srcSpanStringToSourceSpan s = parseOnly pSrcSpan (T.pack s) 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 index eed34527..f1fdeefe 100644 --- 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/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 index 74d93476..9a7c6238 100644 --- 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 index 4e4fbf47..8514e551 100644 --- 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 @@ fi $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 index 00000000..f7f8dc29 --- /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 index 00000000..91c63140 --- /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 index 00000000..e6af49f5 --- /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 index 00000000..624efe99 --- /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 index 00000000..78a5445f --- /dev/null +++ b/test/golden/standalone-multi-module/standalone-multi-module.hdb-test @@ -0,0 +1 @@ +$HDB Main.hs -v 0 < standalone-multi-module.hdb-stdin diff --git a/test/haskell/Test/Integration/Basic.hs b/test/haskell/Test/Integration/Basic.hs index 42aa01cb..eb925749 100644 --- a/test/haskell/Test/Integration/Basic.hs +++ b/test/haskell/Test/Integration/Basic.hs @@ -27,6 +27,10 @@ basicTests = , 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 @@ -89,3 +93,37 @@ internalInterpreterOption = { 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/integration/standalone-multi-module/Helper.hs b/test/integration/standalone-multi-module/Helper.hs new file mode 100644 index 00000000..f7f8dc29 --- /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 index 00000000..91c63140 --- /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."