diff options
author | Roland Senn <rsx@bluewin.ch> | 2020-06-07 14:03:21 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-06-10 04:17:34 -0400 |
commit | 9b283e1b2a46af614d89b0e3a0dfd23871511c17 (patch) | |
tree | f455f0e6d899cc88aa9c007822c1be13c21a27ab | |
parent | 32fd37f5e1e6dc6e3b664ae41e0041ed8a19ae21 (diff) | |
download | haskell-9b283e1b2a46af614d89b0e3a0dfd23871511c17.tar.gz |
Initialize the allocation counter in GHCi to 0 (Fixes #16012)
According to the documentation for the function `getAllocationCounter` in
[System.Mem](http://hackage.haskell.org/package/base-4.14.0.0/docs/System-Mem.html)
initialize the allocationCounter also in GHCi to 0.
-rw-r--r-- | libraries/ghci/GHCi/Run.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T16012.script | 2 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/T16012.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/ghci/should_run/all.T | 1 |
4 files changed, 6 insertions, 2 deletions
diff --git a/libraries/ghci/GHCi/Run.hs b/libraries/ghci/GHCi/Run.hs index b34ba1553f..0a99845966 100644 --- a/libraries/ghci/GHCi/Run.hs +++ b/libraries/ghci/GHCi/Run.hs @@ -250,10 +250,10 @@ redirectInterrupts target wait = do measureAlloc :: IO (EvalResult a) -> IO (EvalStatus a) measureAlloc io = do - setAllocationCounter maxBound + setAllocationCounter 0 -- #16012 a <- io ctr <- getAllocationCounter - let allocs = fromIntegral (maxBound::Int64) - fromIntegral ctr + let allocs = negate $ fromIntegral ctr return (EvalComplete allocs a) -- Exceptions can't be marshaled because they're dynamically typed, so diff --git a/testsuite/tests/ghci/should_run/T16012.script b/testsuite/tests/ghci/should_run/T16012.script new file mode 100644 index 0000000000..f91b037770 --- /dev/null +++ b/testsuite/tests/ghci/should_run/T16012.script @@ -0,0 +1,2 @@ +n <- System.Mem.getAllocationCounter +(n < 0 && n >= -160000) diff --git a/testsuite/tests/ghci/should_run/T16012.stdout b/testsuite/tests/ghci/should_run/T16012.stdout new file mode 100644 index 0000000000..0ca95142bb --- /dev/null +++ b/testsuite/tests/ghci/should_run/T16012.stdout @@ -0,0 +1 @@ +True diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T index 6d39d5794c..1677763591 100644 --- a/testsuite/tests/ghci/should_run/all.T +++ b/testsuite/tests/ghci/should_run/all.T @@ -62,6 +62,7 @@ test('T15633b', ], ghci_script, ['T15633b.script']) +test('T16012', just_ghci, ghci_script, ['T16012.script']) test('T16096', just_ghci, ghci_script, ['T16096.script']) test('T507', just_ghci, ghci_script, ['T507.script']) test('T18027', just_ghci, ghci_script, ['T18027.script']) |