[Git][ghc/ghc][wip/closure-size] ghc-heap: Add closure_size_noopt test

[Ben Gamari]

Ben Gamari pushed to branch wip/closure-size at Glasgow Haskell Compiler / GHC


Commits:
8f9f6874 by Ben Gamari at 2019-06-09T14:56:32Z
ghc-heap: Add closure_size_noopt test

This adds a new test, only run in the `normal` way, to verify the size
of FUNs and PAPs.

- - - - -


4 changed files:

- + libraries/ghc-heap/tests/ClosureSizeUtils.hs
- libraries/ghc-heap/tests/all.T
- libraries/ghc-heap/tests/closure_size.hs
- + libraries/ghc-heap/tests/closure_size_noopt.hs


Changes:

=====================================
libraries/ghc-heap/tests/ClosureSizeUtils.hs
=====================================
@@ -0,0 +1,34 @@
+-- | Utilities for the @closure_size@ tests
+module ClosureSizeUtils (assertSize, assertSizeUnlifted) where
+
+import GHC.Exts.Heap.Closures
+
+assertSize
+  :: forall a. (HasCallStack, Typeable a)
+  => a     -- ^ closure
+  -> Int   -- ^ expected size in words
+  -> IO ()
+assertSize x =
+  assertSizeBox (asBox x) (typeRep @a)
+
+assertSizeUnlifted
+  :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a)
+  => a     -- ^ closure
+  -> Int   -- ^ expected size in words
+  -> IO ()
+assertSizeUnlifted x =
+  assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a)
+
+assertSizeBox
+  :: forall a. (HasCallStack)
+  => Box   -- ^ closure
+  -> TypeRep a
+  -> Int   -- ^ expected size in words
+  -> IO ()
+assertSizeBox x ty expected = do
+  let !size = closureSize x
+  when (size /= expected') $ do
+    putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected'
+    putStrLn $ prettyCallStack callStack
+  where expected' = expected + profHeaderSize
+{-# NOINLINE assertSize #-}


=====================================
libraries/ghc-heap/tests/all.T
=====================================
@@ -5,11 +5,22 @@ test('heap_all',
       omit_ways(['ghci', 'hpc'])
      ],
      compile_and_run, [''])
+
+# Test everything except FUNs and PAPs in all ways.
 test('closure_size',
-     [ when(have_profiling(), extra_ways(['prof'])),
+     [extra_files(['ClosureSizeUtils.hs']),
+      when(have_profiling(), extra_ways(['prof'])),
       # These ways produce slightly different heap representations.
       # Currently we don't test them.
       omit_ways(['hpc'])
      ],
      compile_and_run, [''])
 
+# Test PAPs and FUNs only in normal way (e.g. with -O0)
+# since otherwise the simplifier interferes.
+test('closure_size_noopt',
+     [extra_files(['ClosureSizeUtils.hs']),
+      only_ways(['normal'])
+     ],
+     compile_and_run, [''])
+


=====================================
libraries/ghc-heap/tests/closure_size.hs
=====================================
@@ -12,42 +12,7 @@ import Type.Reflection
 import GHC.Exts
 import GHC.Stack
 import GHC.IO
-
-import GHC.Exts.Heap.Closures
-
-assertSize
-  :: forall a. (HasCallStack, Typeable a)
-  => a     -- ^ closure
-  -> Int   -- ^ expected size in words
-  -> IO ()
-assertSize x =
-  assertSizeBox (asBox x) (typeRep @a)
-
-assertSizeUnlifted
-  :: forall (a :: TYPE 'UnliftedRep). (HasCallStack, Typeable a)
-  => a     -- ^ closure
-  -> Int   -- ^ expected size in words
-  -> IO ()
-assertSizeUnlifted x =
-  assertSizeBox (Box (unsafeCoerce# x)) (typeRep @a)
-
-assertSizeBox
-  :: forall a. (HasCallStack)
-  => Box   -- ^ closure
-  -> TypeRep a
-  -> Int   -- ^ expected size in words
-  -> IO ()
-assertSizeBox x ty expected = do
-  let !size = closureSize x
-  when (size /= expected') $ do
-    putStrLn $ "closureSize ("++show ty++") == "++show size++", expected "++show expected'
-    putStrLn $ prettyCallStack callStack
-  where expected' = expected + profHeaderSize
-{-# NOINLINE assertSize #-}
-
-pap :: Int -> Char -> Int
-pap x _ = x
-{-# NOINLINE pap #-}
+import ClosureSizeUtils
 
 profHeaderSize :: Int
 #if PROFILING
@@ -72,12 +37,6 @@ main = do
   assertSize ((1,2) :: (Int,Int)) 3
   assertSize ((1,2,3) :: (Int,Int,Int)) 4
 
-  -- These depend too much upon the behavior of the simplifier to
-  -- test reliably.
-  --assertSize (id :: Int -> Int) 1
-  --assertSize (fst :: (Int,Int) -> Int) 1
-  --assertSize (pap 1) 2
-
   MA ma <- IO $ \s ->
       case newArray# 0# 0 s of
           (# s1, x #) -> (# s1, MA x #)


=====================================
libraries/ghc-heap/tests/closure_size_noopt.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import ClosureSizeUtils
+
+pap :: Int -> Char -> Int
+pap x _ = x
+{-# NOINLINE pap #-}
+
+main :: IO ()
+main = do
+  assertSize (id :: Int -> Int) 1
+  assertSize (fst :: (Int,Int) -> Int) 1
+  assertSize (pap 1) 2
+



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8f9f687497c39179bf4c88f2e41433d25adb482f

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/commit/8f9f687497c39179bf4c88f2e41433d25adb482f
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20190609/14c759c2/attachment-0001.html>