Skip to content

Commit 8bcca3f

Browse files
alt-romesalt-romes
committed
test: Debug and validate the debugger itself
Introduce a test which tests loading the haskell-debugger onto itself, setting a breakpoint on `runDebugger`, and printing a `FastString` value, expecting the value to be printed according to the pretty `instance DebugView FastString` we gave in `GHC.Debugger.Utils.Orphans`. From here on, we should aim to introduce more `DebugView` instances for the `haskell-debugger` types and (orphan) instances for the `ghc` types, aiming to make debugging the debugger as seamless as possible (also to dogfood this all!) The debugger.yaml CI has to be tweaked to /not/ persist --enable-tests with cabal configure, because when the debugger loads itself it looks at the configured plan and loading the tests which have a build-tool-depends on a multi-repl with that same tool currently fails (see #286) Fixes #245
1 parent abc1373 commit 8bcca3f

9 files changed

Lines changed: 140 additions & 27 deletions

File tree

‎.github/workflows/debugger.yaml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -159,8 +159,9 @@ jobs:
159159

160160
- name: Configure the build
161161
run: |
162-
cabal configure --enable-tests --enable-benchmarks --disable-documentation
163-
cabal build all --dry-run
162+
cabal build all --dry-run \
163+
--enable-executable-dynamic --enable-tests \
164+
--enable-benchmarks --disable-documentation
164165
# The last step generates dist-newstyle/cache/plan.json for the cache key.
165166

166167
- name: Restore cached dependencies

‎haskell-debugger.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -105,6 +105,7 @@ library
105105

106106
GHC.Debugger.Monad,
107107
GHC.Debugger.Utils,
108+
GHC.Debugger.Utils.Orphans,
108109

109110
GHC.Debugger.Session,
110111
GHC.Debugger.Session.Builtin,

‎haskell-debugger/GHC/Debugger/Monad.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -89,12 +89,11 @@ import System.IO (hGetLine, IOMode(..))
8989
import qualified GHC.Linker.Loader as Loader
9090
import GHC.Stack.Annotation
9191
import GHC.Platform.Ways
92-
9392
#if MIN_VERSION_ghc(9,15,0)
9493
import GHC.Data.FastString.Env (emptyFsEnv)
9594
#endif
96-
9795
import GHC.Unit.Home.Graph
96+
import GHC.Debugger.Utils.Orphans () -- bring orphan instances to everything which uses `Debugger`
9897

9998
-- | A debugger action.
10099
newtype Debugger a = Debugger { unDebugger :: ReaderT DebuggerState GHC.Ghc a }

‎haskell-debugger/GHC/Debugger/Utils/Orphans.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
{-# OPTIONS_GHC -Wno-orphans #-}
2+
module GHC.Debugger.Utils.Orphans where
3+
4+
import GHC.Debugger.View.Class
5+
import GHC.Data.FastString
6+
7+
instance DebugView FastString where
8+
debugValue t = simpleValue (unpackFS t) False
9+
debugFields _ = pure (VarFields [])

‎test/golden/self-debug-cli/Main.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
main = putStrLn "Running this program inside the debugger(which is running inside the debugger)"

‎test/golden/self-debug-cli/self-debug-cli.hdb-stdin‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
break --name runDebugger
2+
run cli test/golden/self-debug-cli/Main.hs
3+
print mkFastString "this FastString should be displayed pretty as a string (SHOULD NOT SEE ITS FULL INTERNALS)."
4+
print mkFastString "We have a DebugView FastString instance at this breakpoint."
5+
exit

‎test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.ghc-914.hdb-stdout‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
[ 1 of 53] Compiling Development.Debug.Adapter.Handles ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Handles.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
2+
[ 2 of 53] Compiling Development.Debug.Options ( <PROJECT-ROOT>/hdb/Development/Debug/Options.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
3+
[ 3 of 53] Compiling Development.Debug.Session.Setup ( <PROJECT-ROOT>/hdb/Development/Debug/Session/Setup.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
4+
[ 4 of 53] Compiling GHC.Debugger.Breakpoint.Map ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Breakpoint/Map.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
5+
[ 5 of 53] Compiling GHC.Debugger.Runtime.Compile.Cache ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Compile/Cache.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
6+
[ 6 of 53] Compiling GHC.Debugger.Runtime.Term.Key ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Term/Key.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
7+
[ 7 of 53] Compiling GHC.Debugger.Interface.Messages ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Interface/Messages.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
8+
[ 8 of 53] Compiling GHC.Debugger.Runtime.Interpreter.Custom ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Interpreter/Custom.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
9+
[ 9 of 53] Compiling Development.Debug.Adapter ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
10+
[10 of 53] Compiling Development.Debug.Adapter.Proxy ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Proxy.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
11+
[11 of 53] Compiling Development.Debug.Adapter.Output ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Output.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
12+
[12 of 53] Compiling Development.Debug.Adapter.Interface ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Interface.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
13+
[13 of 53] Compiling Development.Debug.Adapter.Stopped ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Stopped.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
14+
[14 of 53] Compiling Development.Debug.Adapter.Exit.Helpers ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Exit/Helpers.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
15+
[15 of 53] Compiling Development.Debug.Adapter.Exit ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Exit.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
16+
[16 of 53] Compiling Development.Debug.Adapter.ExceptionInfo ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/ExceptionInfo.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
17+
[17 of 53] Compiling Development.Debug.Adapter.Evaluation ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Evaluation.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
18+
[18 of 53] Compiling Development.Debug.Adapter.Stepping ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Stepping.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
19+
[19 of 53] Compiling Development.Debug.Adapter.Breakpoints ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Breakpoints.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
20+
[20 of 53] Compiling GHC.Debugger.Runtime.Thread.Map ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Thread/Map.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
21+
[21 of 53] Compiling GHC.Debugger.Session ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Session.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
22+
[22 of 53] Compiling GHC.Debugger.Session.Builtin ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Session/Builtin.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
23+
[23 of 53] Compiling GHC.Debugger.Session.Interactive ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Session/Interactive.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
24+
[24 of 53] Compiling GHC.Debugger.Utils ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Utils.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
25+
[25 of 53] Compiling GHC.Debugger.View.Class ( <PROJECT-ROOT>/haskell-debugger-view/src/GHC/Debugger/View/Class.hs, interpreted )[haskell-debugger-view-0.2.1.0-inplace]
26+
[26 of 53] Compiling GHC.Debugger.View.ByteString ( <PROJECT-ROOT>/haskell-debugger-view/src/GHC/Debugger/View/ByteString.hs, interpreted )[haskell-debugger-view-0.2.1.0-inplace]
27+
[27 of 53] Compiling GHC.Debugger.Utils.Orphans ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Utils/Orphans.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
28+
[28 of 53] Compiling GHC.Debugger.Runtime.Instances.Discover[boot] ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Instances/Discover.hs-boot, interpreted )[haskell-debugger-0.12.3.0-inplace]
29+
[29 of 53] Compiling GHC.Debugger.Monad ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Monad.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
30+
[30 of 53] Compiling GHC.Debugger.Runtime.Instances.Discover ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Instances/Discover.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
31+
[31 of 53] Compiling GHC.Debugger.Runtime.Eval ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Eval.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
32+
[32 of 53] Compiling GHC.Debugger.Runtime.Compile ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Compile.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
33+
[33 of 53] Compiling GHC.Debugger.Runtime.Eval.RemoteExpr ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Eval/RemoteExpr.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
34+
[34 of 53] Compiling GHC.Debugger.Runtime.Term.Parser ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Term/Parser.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
35+
[35 of 53] Compiling GHC.Debugger.Runtime.Instances ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Instances.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
36+
[36 of 53] Compiling GHC.Debugger.Runtime.Eval.RemoteExpr.Builtin ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Eval/RemoteExpr/Builtin.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
37+
[37 of 53] Compiling GHC.Debugger.Runtime.Thread.Stack ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Thread/Stack.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
38+
[38 of 53] Compiling GHC.Debugger.Runtime.Thread ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime/Thread.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
39+
[39 of 53] Compiling GHC.Debugger.Stopped.Exception ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Stopped/Exception.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
40+
[40 of 53] Compiling GHC.Debugger.Runtime ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Runtime.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
41+
[41 of 53] Compiling GHC.Debugger.Stopped.Variables ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Stopped/Variables.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
42+
[42 of 53] Compiling GHC.Debugger.Stopped ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Stopped.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
43+
[43 of 53] Compiling GHC.Debugger.Run ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Run.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
44+
[44 of 53] Compiling GHC.Debugger.Breakpoint ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger/Breakpoint.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
45+
[45 of 53] Compiling GHC.Debugger ( <PROJECT-ROOT>/haskell-debugger/GHC/Debugger.hs, interpreted )[haskell-debugger-0.12.3.0-inplace]
46+
[46 of 53] Compiling Development.Debug.Interactive ( <PROJECT-ROOT>/hdb/Development/Debug/Interactive.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
47+
[47 of 53] Compiling Development.Debug.Adapter.Init ( <PROJECT-ROOT>/hdb/Development/Debug/Adapter/Init.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
48+
[48 of 53] Compiling GHC.Debugger.View.Containers ( <PROJECT-ROOT>/haskell-debugger-view/src/GHC/Debugger/View/Containers.hs, interpreted )[haskell-debugger-view-0.2.1.0-inplace]
49+
[49 of 53] Compiling GHC.Debugger.View.Text ( <PROJECT-ROOT>/haskell-debugger-view/src/GHC/Debugger/View/Text.hs, interpreted )[haskell-debugger-view-0.2.1.0-inplace]
50+
[50 of 53] Compiling Paths_haskell_debugger ( <AUTOGEN-DIR>/Paths_haskell_debugger.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
51+
[51 of 53] Compiling Development.Debug.Options.Parser ( <PROJECT-ROOT>/hdb/Development/Debug/Options/Parser.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
52+
[52 of 53] Compiling Main ( <PROJECT-ROOT>/hdb/Main.hs, interpreted )[haskell-debugger-0.12.3.0-inplace-hdb]
53+
(hdb) Stopped at breakpoint
54+
(hdb) this FastString should be displayed pretty as a string (SHOULD NOT SEE ITS FULL INTERNALS).
55+
(hdb) We have a DebugView FastString instance at this breakpoint.
56+
(hdb) Exiting...

‎test/golden/self-debug-cli/self-debug-cli.no-tmp-dir.external.hdb-test‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
#!/bin/sh
2+
3+
# 1) Run only in .external mode because there are some issues in loading ghc into
4+
# itself with the internal interpreter. Didn't investigate thoroughly.
5+
#
6+
# 2) Since this test is named `....no-tmp-dir....` then it will be run in the root of the tree
7+
#
8+
# 3) Grep out the `BreakFound` word. It doesn't matter for the test and it is
9+
# too prone to changing because it reports source lines of the actual debugger
10+
# source, which we change all the time (unlike testsuite programs).
11+
#
12+
# 4) Normalize cabal autogen paths (e.g. `Paths_haskell_debugger.hs`).
13+
# It's not immediately clear why these go in .cache/hie-bios/... rather than in
14+
# $HDB_CACHE_DIR, but I guess it's an autogen thing rather than the actual
15+
# compilation artifacts cache (.hi, ...)
16+
#
17+
# 5) When testing the sdist (just the packaged things), the root doesn't have a hie.yaml.
18+
# Add one temporarily
19+
created_yaml=false
20+
if [ ! -f hie.yaml ]; then
21+
echo 'cradle:\n cabal:\n component: "all"' > hie.yaml
22+
created_yaml=true;
23+
fi
24+
25+
$HDB -v0 hdb/Main.hs < "test/golden/self-debug-cli/self-debug-cli.hdb-stdin" 2>&1 \
26+
| grep -v "BreakFound" \
27+
| sed 's|[^ ]*/Paths_haskell_debugger.hs|<AUTOGEN-DIR>/Paths_haskell_debugger.hs|g'
28+
29+
if [ $created_yaml = true ]; then
30+
rm hie.yaml
31+
fi

‎test/haskell/Main.hs‎

Lines changed: 33 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
{-# LANGUAGE LambdaCase, OverloadedStrings, ViewPatterns, QuasiQuotes, CPP #-}
22
module Main (main) where
33

4-
import Data.List (isSuffixOf)
4+
import Data.List (isSuffixOf, isInfixOf)
55
import qualified Data.Set as Set
66
import Text.RE.TDFA.Text.Lazy
77
import Text.Printf
@@ -10,6 +10,7 @@ import qualified Data.Text.Lazy.Encoding as LT
1010
import qualified Data.Text.Lazy.IO as LT
1111
import qualified Data.ByteString.Lazy.Char8 as LBS
1212
import qualified System.Process as P
13+
import System.Directory
1314
import System.FilePath
1415
import qualified System.FilePath.Posix as Posix
1516
import System.IO.Temp
@@ -71,8 +72,8 @@ main = do
7172
-- (since they run as separate processes). To use a single golden test file for
7273
-- both modes, we disable IPE backtraces by default in tests.
7374
let baseFlags = "--disable-ipe-backtraces"
74-
default_goldens <- mapM (mkTest baseFlags) testsForExternal
75-
intinterp_goldens <- mapM (mkTest ("--internal-interpreter " ++ baseFlags)) testsForInternal
75+
let default_goldens = map (mkTest baseFlags) testsForExternal
76+
let intinterp_goldens = map (mkTest ("--internal-interpreter " ++ baseFlags)) testsForInternal
7677

7778
defaultMain $
7879
testGroup "Tests"
@@ -105,30 +106,36 @@ unitTests =
105106

106107
-- | Receives as an argument the path to the @*.hdb-test@ which contains the
107108
-- shell invocation for running
108-
mkGoldenTest :: Bool -> [(String, String)] -> FilePath -> String -> IO TestTree
109-
mkGoldenTest keepTmpDirs inheritedEnv flags path = do
110-
let testName = takeBaseName path
111-
let goldenPath = replaceExtension path (".ghc-" ++ ghcVersionTag ++ ".hdb-stdout")
112-
return $ goldenVsStringComparing testName goldenPath action
109+
mkGoldenTest :: Bool -> [(String, String)] -> FilePath -> String -> TestTree
110+
mkGoldenTest keepTmpDirs inheritedEnv flags path = goldenVsStringComparing testName goldenPath topAction
113111
where
114112
ghcVersionTag :: String
115113
ghcVersionTag = show (__GLASGOW_HASKELL__ :: Int)
116114

117-
action :: IO LBS.ByteString
118-
action = do
119-
withHermeticDir keepTmpDirs (takeDirectory path) $ \test_dir -> do
120-
(_, Just hout, _, p)
121-
<- P.createProcess (P.proc "sh" [takeFileName path])
122-
{ P.cwd = Just test_dir, P.std_out = P.CreatePipe
123-
, P.env = Just $
124-
inheritedEnv ++
125-
[ ("HDB_CACHE_DIR", test_dir </> ".hdb-cache") ] ++
126-
[ ("HDB", "hdb " ++ flags)
127-
]
128-
}
129-
P.waitForProcess p >>= \case
130-
ExitSuccess -> LBS.hGetContents hout
131-
ExitFailure c -> error $ "Test script in " ++ test_dir ++ " failed with exit code: " ++ show c
115+
testName = takeBaseName path
116+
goldenPath = replaceExtension path (".ghc-" ++ ghcVersionTag ++ ".hdb-stdout")
117+
118+
noTmpDir = ".no-tmp-dir" `isInfixOf` testName
119+
120+
topAction :: IO LBS.ByteString
121+
topAction | noTmpDir = testAction path =<< getCurrentDirectory -- a bit dangerous! used in the self-debug-cli test
122+
| otherwise = withHermeticDir keepTmpDirs (takeDirectory path) (testAction (takeFileName path))
123+
124+
125+
testAction :: FilePath -> FilePath -> IO LBS.ByteString
126+
testAction test_path test_dir = do
127+
(_, Just hout, _, p)
128+
<- P.createProcess (P.proc "sh" [test_path])
129+
{ P.cwd = Just test_dir, P.std_out = P.CreatePipe
130+
, P.env = Just $
131+
inheritedEnv ++
132+
[ ("HDB_CACHE_DIR", test_dir </> ".hdb-cache")
133+
, ("HDB", "hdb " ++ flags)
134+
]
135+
}
136+
P.waitForProcess p >>= \case
137+
ExitSuccess -> LBS.hGetContents hout
138+
ExitFailure c -> error $ "Test script in " ++ test_dir ++ " failed with exit code: " ++ show c
132139

133140
--------------------------------------------------------------------------------
134141
-- Tasty Golden Advanced wrapper
@@ -172,6 +179,7 @@ goldenVsStringComparing name ref act =
172179
-- Normalise the action producing the output
173180
normalisingAct = do
174181
tmpDir <- getCanonicalTemporaryDirectory
182+
cwd <- getCurrentDirectory
175183
let
176184
winTempDirWithForwardSlashes = useForwardSlashes tmpDir
177185
let posixTempDirRegex =
@@ -190,6 +198,8 @@ goldenVsStringComparing name ref act =
190198
, "<TEMPORARY-DIRECTORY>" )
191199
, ( "\\.hdb-cache/[^/]+/"
192200
, ".hdb-cache/<CACHE-ENTRY>/" )
201+
, ( escapeRegex cwd
202+
, "<PROJECT-ROOT>" )
193203
]
194204

195205
let normalising (LT.decodeUtf8 -> txt) = LT.filter (/= '\r') $ foldl' (*=~/) txt replaceREs

0 commit comments

Comments
 (0)