fix: Look for active breaks in right ModBreaks

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 []

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
+    ]

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

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
+    ]

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 ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Handles.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[ 2 of 53] Compiling Development.Debug.Options ( <PROJECT-ROOT>/hdb/Development/Debug/Options.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[ 3 of 53] Compiling Development.Debug.Session.Setup ( <PROJECT-ROOT>/hdb/Development/Debug/Session/Setup.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[ 4 of 53] Compiling GHC.Debugger.Breakpoint.Map ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[ 5 of 53] Compiling GHC.Debugger.Runtime.Compile.Cache ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Compile/Cache.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[ 6 of 53] Compiling GHC.Debugger.Runtime.Term.Key ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Term/Key.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[ 7 of 53] Compiling GHC.Debugger.Interface.Messages ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Interface/Messages.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[ 8 of 53] Compiling GHC.Debugger.Runtime.Interpreter.Custom ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Interpreter/Custom.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[ 9 of 53] Compiling Development.Debug.Adapter ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[10 of 53] Compiling Development.Debug.Adapter.Proxy ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Proxy.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[11 of 53] Compiling Development.Debug.Adapter.Output ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Output.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[12 of 53] Compiling Development.Debug.Adapter.Interface ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Interface.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[13 of 53] Compiling Development.Debug.Adapter.Stopped ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Stopped.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[14 of 53] Compiling Development.Debug.Adapter.Exit.Helpers ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Exit/Helpers.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[15 of 53] Compiling Development.Debug.Adapter.Exit ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Exit.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[16 of 53] Compiling Development.Debug.Adapter.ExceptionInfo ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/ExceptionInfo.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[17 of 53] Compiling Development.Debug.Adapter.Evaluation ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Evaluation.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[18 of 53] Compiling Development.Debug.Adapter.Stepping ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Stepping.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[19 of 53] Compiling Development.Debug.Adapter.Breakpoints ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Breakpoints.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[20 of 53] Compiling GHC.Debugger.Runtime.Thread.Map ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Thread/Map.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[21 of 53] Compiling GHC.Debugger.Session ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Session.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[22 of 53] Compiling GHC.Debugger.Session.Builtin ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Session/Builtin.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[23 of 53] Compiling GHC.Debugger.Session.Interactive ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Session/Interactive.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[24 of 53] Compiling GHC.Debugger.Utils ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Utils.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[25 of 53] Compiling GHC.Debugger.View.Class ( <PROJECT-ROOT>/haskell-debugger-view/src/GHC/Debugger/View/Class.hs, interpreted )[haskell-debugger-view-<VERSION>-inplace]
-[26 of 53] Compiling GHC.Debugger.View.ByteString ( <PROJECT-ROOT>/haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs, interpreted )[haskell-debugger-view-<VERSION>-inplace]
-[27 of 53] Compiling GHC.Debugger.Utils.Orphans ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Utils/Orphans.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[28 of 53] Compiling GHC.Debugger.Runtime.Instances.Discover[boot] ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Instances/Discover.hs-boot, interpreted )[haskell-debugger-<VERSION>-inplace]
-[29 of 53] Compiling GHC.Debugger.Monad ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Monad.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[30 of 53] Compiling GHC.Debugger.Runtime.Instances.Discover ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Instances/Discover.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[31 of 53] Compiling GHC.Debugger.Runtime.Eval ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Eval.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[32 of 53] Compiling GHC.Debugger.Runtime.Compile ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Compile.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[33 of 53] Compiling GHC.Debugger.Runtime.Eval.RemoteExpr ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Eval/RemoteExpr.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[34 of 53] Compiling GHC.Debugger.Runtime.Term.Parser ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Term/Parser.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[35 of 53] Compiling GHC.Debugger.Runtime.Instances ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Instances.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[36 of 53] Compiling GHC.Debugger.Runtime.Eval.RemoteExpr.Builtin ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Eval/RemoteExpr/Builtin.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[37 of 53] Compiling GHC.Debugger.Runtime.Thread.Stack ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Thread/Stack.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[38 of 53] Compiling GHC.Debugger.Runtime.Thread ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Thread.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[39 of 53] Compiling GHC.Debugger.Stopped.Exception ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Stopped/Exception.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[40 of 53] Compiling GHC.Debugger.Runtime ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[41 of 53] Compiling GHC.Debugger.Stopped.Variables ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Stopped/Variables.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[42 of 53] Compiling GHC.Debugger.Stopped ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Stopped.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[43 of 53] Compiling GHC.Debugger.Run ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Run.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[44 of 53] Compiling GHC.Debugger.Breakpoint ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Breakpoint.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[45 of 53] Compiling GHC.Debugger     ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger.hs, interpreted )[haskell-debugger-<VERSION>-inplace]
-[46 of 53] Compiling Development.Debug.Interactive ( <PROJECT-ROOT>/hdb/Development/Debug/Interactive.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[47 of 53] Compiling Development.Debug.Adapter.Init ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Init.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[48 of 53] Compiling GHC.Debugger.View.Containers ( <PROJECT-ROOT>/haskell-debugger-view/src/GHC/Debugger/View/Containers.hs, interpreted )[haskell-debugger-view-<VERSION>-inplace]
-[49 of 53] Compiling GHC.Debugger.View.Text ( <PROJECT-ROOT>/haskell-debugger-view/src/GHC/Debugger/View/Text.hs, interpreted )[haskell-debugger-view-<VERSION>-inplace]
-[50 of 53] Compiling Paths_haskell_debugger ( <AUTOGEN-DIR>/Paths_haskell_debugger.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[51 of 53] Compiling Development.Debug.Options.Parser ( <PROJECT-ROOT>/hdb/Development/Debug/Options/Parser.hs, interpreted )[haskell-debugger-<VERSION>-inplace-hdb]
-[52 of 53] Compiling Main             ( <PROJECT-ROOT>/hdb/Main.hs, interpreted )[haskell-debugger-<VERSION>-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.

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|<AUTOGEN-DIR>/Paths_haskell_debugger.hs|g' \
       -e 's|haskell-debugger-[0-9.][0-9.]*-inplace|haskell-debugger-<VERSION>-inplace|g' \

test/golden/standalone-multi-module/Helper.hs

@@ -0,0 +1,5 @@
+module Helper where
+
+greet :: String -> IO ()
+greet name = do
+  putStrLn ("Hello, " ++ name ++ "!")

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."

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           ( <TEMPORARY-DIRECTORY>/Helper.hs, interpreted )[main]
+[3 of 4] Compiling Main             ( <TEMPORARY-DIRECTORY>/Main.hs, interpreted )[main]
+(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Main 5], sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/Main.hs", startLine = 7, endLine = 7, startCol = 3, endCol = 25}}
+(hdb) BreakFound {changed = True, breakId = [InternalBreakpointId Helper 4], sourceSpan = SourceSpan {file = "<TEMPORARY-DIRECTORY>/./Helper.hs", startLine = 5, endLine = 5, startCol = 3, endCol = 38}}
+(hdb) Stopped at breakpoint
+(hdb) Starting...
+Stopped at breakpoint
+(hdb) Exiting...

test/golden/standalone-multi-module/standalone-multi-module.hdb-stdin

@@ -0,0 +1,4 @@
+break Main.hs 7
+break Helper.hs 5
+run
+continue

test/golden/standalone-multi-module/standalone-multi-module.hdb-test

@@ -0,0 +1 @@
+$HDB Main.hs -v 0 < standalone-multi-module.hdb-stdin

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

test/integration/standalone-multi-module/Helper.hs

@@ -0,0 +1,5 @@
+module Helper where
+
+greet :: String -> IO ()
+greet name = do
+  putStrLn ("Hello, " ++ name ++ "!")

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."