Commit e5d275f4 authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot
Browse files

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.
parent 2f945086
Pipeline #6872 failed with stages
in 938 minutes and 18 seconds
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Utilities for the @closure_size@ tests
module ClosureSizeUtils (assertSize, assertSizeUnlifted) where
import Control.Monad
import GHC.Exts
import GHC.Exts.Heap.Closures
import GHC.Stack
import Type.Reflection
profHeaderSize :: Int
#if PROFILING
profHeaderSize = 2
#else
profHeaderSize = 0
#endif
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 #-}
......@@ -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, [''])
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
import Control.Monad
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 #-}
profHeaderSize :: Int
#if PROFILING
profHeaderSize = 2
#else
profHeaderSize = 0
#endif
import ClosureSizeUtils
data A = A (Array# Int)
data MA = MA (MutableArray# RealWorld Int)
......@@ -72,12 +24,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 #)
......
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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment