Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
29 changes: 27 additions & 2 deletions test/haskell/Test/Integration/Variables.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,9 +8,7 @@ import qualified Data.Text as T
import Test.DAP
import Test.Tasty
import Test.Tasty.HUnit
#ifdef mingw32_HOST_OS
import Test.Tasty.ExpectedFailure
#endif
import DAP (Variable, variableValue)

variableTests :: TestTree
Expand All @@ -34,6 +32,8 @@ variableTests =
, testCase "hdv in-memory with containers (issue #47d)" hdvContainersMemTest
, testCase "hdv in-memory with text (issue #47e)" hdvTextMemTest
, testCase "force thunk in IntMap value persists (issue #47f)" thunkIntMapTest
, expectFailBecause "issue #301" $
testCase "force thunk in custom DebugView field (issue #301)" thunkFieldTest
]

intsAndStringsTest :: Assertion
Expand Down Expand Up @@ -344,3 +344,28 @@ thunkIntMapTest =
(ac2 % "1") @==? "5050"
disconnect

-- | A custom DebugView field that wraps a thunk, when forced, should return
-- the forced value. A subsequent request should still show the result forced.
-- It is no longer a thunk after being forced the first time!
--
-- Issue #301 observes that the subsequent request showed the field again as a
-- thunk.
thunkFieldTest :: Assertion
thunkFieldTest =
withTestDAPServer "test/integration/T301" [] $ \test_dir server ->
withTestDAPServerClient server $ do
let cfg = mkLaunchConfig test_dir "Main.hs"
hitBreakpointWith cfg 21
locals <- fetchLocalVars
action <- forceLazy (locals % "action")
action @==? "T301-X"
ac <- expandVar action
ti <- forceLazy (ac % "thunkInt")
ti @==? "5050"

-- Re-request the parent and check the field is still evaluated.
-- (it does not need to be forced again!)
locals2 <- fetchLocalVars
ac2 <- expandVar (locals2 % "action")
(ac2 % "thunkInt") @==? "5050"
disconnect
21 changes: 21 additions & 0 deletions test/integration/T301/Main.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,21 @@
module Main where
import GHC.Debugger.View.Class

data X = X String
deriving Show

instance DebugView X where
debugValue _ = simpleValue "T301-X" True
debugFields (X s) = pure $ VarFields
[ ("thunkInt", VarFieldValue intThunk)
]
where
intThunk :: Int
intThunk = sum [1 .. length s + 99]

main :: IO ()
main = f (X "A")

f :: Show a => a -> IO ()
f action = do
print action
18 changes: 18 additions & 0 deletions test/integration/T301/T301.cabal
Original file line number Diff line number Diff line change
@@ -0,0 +1,18 @@
cabal-version: 3.14
name: T301
version: 0.1.0.0
license: NONE
author: Rodrigo Mesquita
maintainer: rodrigo.m.mesquita@gmail.com
build-type: Simple

common warnings
ghc-options: -Wall

executable t301
import: warnings
main-is: Main.hs
build-depends: base, containers
build-depends: haskell-debugger-view
hs-source-dirs: .
default-language: Haskell2010
Loading