Skip to content

Commit e3b7f9c

Browse files
committed
test: Also do self-debug test with DAP server
This test tried, but didn't exhibit the bug in #294. It is a good end-to-end test nonetheless, so we should keep it.
1 parent 1197309 commit e3b7f9c

3 files changed

Lines changed: 59 additions & 1 deletion

File tree

haskell-debugger.cabal

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -243,7 +243,8 @@ test-suite haskell-debugger-test
243243
Test.Integration.Stdout,
244244
Test.Integration.Conditional,
245245
Test.Integration.Evaluate,
246-
Test.Integration.StackTrace
246+
Test.Integration.StackTrace,
247+
Test.Integration.SelfDebug
247248
build-depends:
248249
base >=4.14,
249250
async,

test/haskell/Main.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ import Test.Integration.Stdout (stdoutTests)
3838
import Test.Integration.Conditional (conditionalTests)
3939
import Test.Integration.Evaluate (evaluateTests)
4040
import Test.Integration.StackTrace (stackTraceTests)
41+
import Test.Integration.SelfDebug (selfDebugTests)
4142
import Test.Utils
4243
import qualified Data.Char as C
4344
import qualified Data.Text as T
@@ -102,6 +103,7 @@ unitTests =
102103
, conditionalTests
103104
, evaluateTests
104105
, stackTraceTests
106+
, selfDebugTests
105107
]
106108

107109
-- | Receives as an argument the path to the @*.hdb-test@ which contains the
Lines changed: 55 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,55 @@
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
module Test.Integration.SelfDebug (selfDebugTests) where
4+
5+
import Control.Monad.IO.Class (liftIO)
6+
import Data.Aeson
7+
import System.Directory (getCurrentDirectory)
8+
import Test.DAP
9+
import Test.DAP.Messages.Parser (Event(..))
10+
import Test.Tasty
11+
import Test.Tasty.HUnit
12+
import qualified DAP
13+
import DAP.Types (StoppedEvent(..))
14+
#ifdef mingw32_HOST_OS
15+
import Test.Tasty.ExpectedFailure
16+
#endif
17+
18+
selfDebugTests :: TestTree
19+
selfDebugTests =
20+
#ifdef mingw32_HOST_OS
21+
ignoreTestBecause "Needs to be fixed for Windows (#199)" $
22+
#endif
23+
testGroup "DAP.Integration.SelfDebug"
24+
[ testCase "debug the debugger itself via DAP" selfDebugDAPTest
25+
]
26+
27+
selfDebugDAPTest :: Assertion
28+
selfDebugDAPTest = do
29+
projectRoot <- getCurrentDirectory -- Self-debug test copies project root to temp dir
30+
withTestDAPServer projectRoot [] $ \test_dir server -> do
31+
withTestDAPServerClient server $ do
32+
let cfg = LaunchConfig
33+
{ lcProjectRoot = test_dir
34+
, lcEntryFile = Just "hdb/Main.hs"
35+
, lcEntryPoint = Just "main"
36+
, lcEntryArgs = ["cli", "test/golden/self-debug-cli/Main.hs"]
37+
, lcExtraGhcArgs = []
38+
, lcInternalInterpreter = Nothing
39+
}
40+
41+
_ <- sync $ launchWith cfg
42+
waitFiltering_ EventTy "initialized"
43+
44+
_ <- sync $ setFunctionBreakpointsRequest @_ @Value $ object
45+
[ "breakpoints" .= [ object [ "name" .= ("runDebugger" :: String) ] ] ]
46+
47+
_ <- sync configurationDone
48+
49+
Event{eventBody = Just StoppedEvent{stoppedEventReason = reason}}
50+
<- waitFiltering EventTy "stopped"
51+
liftIO $ assertEqual "expected breakpoint stop"
52+
reason DAP.StoppedEventReasonBreakpoint
53+
-- fixme: should we reply with StoppedEventReasonFunctionBreakpoint instead?
54+
55+
disconnect

0 commit comments

Comments
 (0)