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