Space tests for present and drawColor

Case                      Allocated  GCs
pollEvent + present 1         2,072    0
pollEvent + present 10        2,704    0
pollEvent + present 100       2,872    0
pollEvent + present 1000      2,872    0

Case                        Allocated  GCs
pollEvent + drawColor 1         2,160    0
pollEvent + drawColor 10        2,792    0
pollEvent + drawColor 100       2,960    0
pollEvent + drawColor 1000      2,960    0
pollEvent + drawColor 5000      2,960    0

Author: chrisdone

bench/Space.hs

@@ -39,6 +39,34 @@ main =
                                "Allocated >3KB! Allocations should be constant."
                         else Nothing)
           | i <- [1, 10, 100, 1000, 10000]
+          ]
+        sequence_
+          [ validateAction
+            ("pollEvent + present " ++ show i)
+            pollEventPresentTest
+            i
+            (\weight ->
+               if weightGCs weight > 0
+                 then Just "Non-zero number of garbage collections!"
+                 else if weightAllocatedBytes weight > 3000
+                        then Just
+                               "Allocated >3KB! Allocations should be constant."
+                        else Nothing)
+          | i <- [1, 10, 100, 1000]
+          ]
+        sequence_
+          [ validateAction
+            ("pollEvent + drawColor " ++ show i)
+            pollEventDrawColorTest
+            i
+            (\weight ->
+               if weightGCs weight > 0
+                 then Just "Non-zero number of garbage collections!"
+                 else if weightAllocatedBytes weight > 3000
+                        then Just
+                               "Allocated >3KB! Allocations should be constant."
+                        else Nothing)
+          | i <- [1, 10, 100, 1000, 2000]
           ])
 
 -- | Test that merely polling does not allocate or engage the GC.
@@ -67,3 +95,36 @@ pollEventClearTest iters = do
         clear renderer
         go (i - 1)
   go iters
+
+-- | Test that merely polling and presenting does not allocate or
+-- engage the GC.
+pollEventPresentTest :: Int -> IO ()
+pollEventPresentTest iters = do
+  initializeAll
+  window <- createWindow "pollEventClearTest" defaultWindow
+  renderer <- createRenderer window (-1) defaultRenderer
+  let go :: Int -> IO ()
+      go 0 = pure ()
+      go i = do
+        _ <- pollEvent
+        clear renderer
+        present renderer
+        go (i - 1)
+  go iters
+
+-- | Test that merely polling and drawColoring does not allocate or
+-- engage the GC.
+pollEventDrawColorTest :: Int -> IO ()
+pollEventDrawColorTest iters = do
+  initializeAll
+  window <- createWindow "pollEventClearTest" defaultWindow
+  renderer <- createRenderer window (-1) defaultRenderer
+  let go :: Int -> IO ()
+      go 0 = pure ()
+      go i = do
+        _ <- pollEvent
+        rendererDrawColor renderer $= V4 0 0 255 255
+        clear renderer
+        present renderer
+        go (i - 1)
+  go iters