summaryrefslogtreecommitdiff
path: root/testsuite/tests/rts/alloccounter1.hs
diff options
context:
space:
mode:
authorSimon Marlow <marlowsd@gmail.com>2018-01-05 16:12:49 +0000
committerSimon Marlow <marlowsd@gmail.com>2018-01-08 08:41:35 +0000
commita1a689dda48113f3735834350fb562bb1927a633 (patch)
tree0931516152cc40f0481bb2fad35274f225bcd76c /testsuite/tests/rts/alloccounter1.hs
parent303106d55d75a9c796e58867cb541ad136bb217f (diff)
downloadhaskell-a1a689dda48113f3735834350fb562bb1927a633.tar.gz
Improve accuracy of get/setAllocationCounter
Summary: get/setAllocationCounter didn't take into account allocations in the current block. This was known at the time, but it turns out to be important to have more accuracy when using these in a fine-grained way. Test Plan: New unit test to test incrementally larger allocaitons. Before I got results like this: ``` +0 +0 +0 +0 +0 +4096 +0 +0 +0 +0 +0 +4064 +0 +0 +4088 +4056 +0 +0 +0 +4088 +4096 +4056 +4096 ``` Notice how the results aren't always monotonically increasing. After this patch: ``` +344 +416 +488 +560 +632 +704 +776 +848 +920 +992 +1064 +1136 +1208 +1280 +1352 +1424 +1496 +1568 +1640 +1712 +1784 +1856 +1928 +2000 +2072 +2144 ``` Reviewers: niteria, bgamari, hvr, erikd Subscribers: rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4288
Diffstat (limited to 'testsuite/tests/rts/alloccounter1.hs')
-rw-r--r--testsuite/tests/rts/alloccounter1.hs19
1 files changed, 19 insertions, 0 deletions
diff --git a/testsuite/tests/rts/alloccounter1.hs b/testsuite/tests/rts/alloccounter1.hs
new file mode 100644
index 0000000000..4b81896d2c
--- /dev/null
+++ b/testsuite/tests/rts/alloccounter1.hs
@@ -0,0 +1,19 @@
+module Main where
+
+import Control.Exception
+import Control.Monad
+import Data.List
+import System.Mem
+
+main = do
+ let
+ testAlloc n = do
+ let start = 999999
+ setAllocationCounter start
+ evaluate (last [1..n])
+ c <- getAllocationCounter
+ -- print (start - c)
+ return (start - c)
+ results <- forM [1..1000] testAlloc
+ print (sort results == results)
+ -- results better be in ascending order