base/encoding: add an allocations performance test (#22946)

2 files changed, 39 insertions, 0 deletions

diff --git a/libraries/base/tests/perf/all.T b/libraries/base/tests/perf/all.T
index 61f42f5420..9cc1d8a128 100644
--- a/libraries/base/tests/perf/all.T
+++ b/libraries/base/tests/perf/all.T
@@ -1,5 +1,14 @@
+# .stats files aren't yet supported in the JS backend
+setTestOpts(js_skip)
+
 #--------------------------------------
 # Check specialization of elem via rules
 #--------------------------------------
 
 test('T17752', [only_ways(['normal'])] , makefile_test, ['T17752'])
+
+#--------------------------------------
+
+# We don't expect the code in test to vary at all, but the variance is set to
+# 1% in case the constant allocations increase by other means.
+test('encodingAllocations', [only_ways(['normal']), collect_stats('bytes allocated', 1)], compile_and_run, ['-O2'])
diff --git a/libraries/base/tests/perf/encodingAllocations.hs b/libraries/base/tests/perf/encodingAllocations.hs
new file mode 100755
index 0000000000..cd136963cb
--- /dev/null
+++ b/libraries/base/tests/perf/encodingAllocations.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -dno-typeable-binds -O2 #-}
+
+module Main (main) where
+
+import System.IO
+import Data.Bits
+import GHC.Int
+import GHC.Exts
+import System.Environment
+import Distribution.Simple.Utils
+
+
+main :: IO ()
+main = withTempFile "." "encodingAllocations.tmp" (const $ loop 1000000)
+
+loop :: Int -> Handle -> IO ()
+loop 0  !_ = pure ()
+loop !n !h = do
+  hPutChar h $! dummy_char n
+  loop (n-1) h
+
+-- unsafe efficient version of `chr`
+my_chr :: Int -> Char
+my_chr (I# i) = C# (chr# i)
+
+-- return either a or b
+dummy_char :: Int -> Char
+dummy_char !i = my_chr ((i .&. 1) + 97)