[Git][ghc/ghc][wip/decode_cloned_stack] Adjust sizes for 32bit in stack_misc_closures test

[Sven Tennie (@supersven)]

Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC


Commits:
ffa31521 by Sven Tennie at 2023-02-10T17:54:06+00:00
Adjust sizes for 32bit in stack_misc_closures test

- - - - -


1 changed file:

- libraries/ghc-heap/tests/stack_misc_closures.hs


Changes:

=====================================
libraries/ghc-heap/tests/stack_misc_closures.hs
=====================================
@@ -13,6 +13,8 @@
 module Main where
 
 -- TODO: Remove later
+
+import Data.Functor
 import Debug.Trace
 import GHC.Exts
 import GHC.Exts.DecodeStack
@@ -24,7 +26,6 @@ import GHC.Stack.CloneStack (StackSnapshot (..))
 import System.Mem
 import TestUtils
 import Unsafe.Coerce (unsafeCoerce)
-import Data.Functor
 
 foreign import prim "any_update_framezh" any_update_frame# :: SetupFunction
 
@@ -176,9 +177,9 @@ main = do
         assertEqual (tipe info) RET_SMALL
         assertEqual knownRetSmallType None
         pCs <- mapM getBoxedClosureData payload
-        assertEqual (length pCs) (fromIntegral maxSmallBitmapBits_c)
+        assertEqual (length pCs) maxSmallBitmapBits
         let wds = map getWordFromConstr01 pCs
-        assertEqual wds [1 .. 58]
+        assertEqual wds [1 .. maxSmallBitmapBits]
       e -> error $ "Wrong closure type: " ++ show e
   traceM $ "Test 16"
   testSize any_ret_small_closures_frame# (1 + fromIntegral maxSmallBitmapBits_c)
@@ -189,9 +190,9 @@ main = do
         assertEqual (tipe info) RET_SMALL
         assertEqual knownRetSmallType None
         pCs <- mapM getBoxedClosureData payload
-        assertEqual (length pCs) (fromIntegral maxSmallBitmapBits_c)
+        assertEqual (length pCs) maxSmallBitmapBits
         let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs
-        assertEqual wds [1 .. 58]
+        assertEqual wds [1 .. maxSmallBitmapBits]
       e -> error $ "Wrong closure type: " ++ show e
   traceM $ "Test 18"
   testSize any_ret_small_prims_frame# (1 + fromIntegral maxSmallBitmapBits_c)
@@ -201,9 +202,9 @@ main = do
       RetBig {..} -> do
         assertEqual (tipe info) RET_BIG
         pCs <- mapM getBoxedClosureData payload
-        assertEqual (length pCs) 59
+        assertEqual (length pCs) minBigBitmapBits
         let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs
-        assertEqual wds [1 .. 59]
+        assertEqual wds [1 .. minBigBitmapBits]
       e -> error $ "Wrong closure type: " ++ show e
   traceM $ "Test 20"
   testSize any_ret_big_prims_min_frame# (minBigBitmapBits + 1)
@@ -213,9 +214,9 @@ main = do
       RetBig {..} -> do
         assertEqual (tipe info) RET_BIG
         pCs <- mapM getBoxedClosureData payload
-        assertEqual (length pCs) 59
+        assertEqual (length pCs) minBigBitmapBits
         let wds = map getWordFromConstr01 pCs
-        assertEqual wds [1 .. 59]
+        assertEqual wds [1 .. minBigBitmapBits]
       e -> error $ "Wrong closure type: " ++ show e
   traceM $ "Test 22"
   testSize any_ret_big_closures_min_frame# (minBigBitmapBits + 1)
@@ -267,6 +268,7 @@ main = do
   traceM $ "Test 27"
   testSize any_ret_fun_arg_gen_framezh# (3 + 9)
   traceM $ "Test 28"
+  -- TODO: Check names: # and zh
   test any_ret_fun_arg_gen_big_framezh# $
     \case
       RetFun {..} -> do
@@ -386,7 +388,7 @@ test setup assertion = do
 
 entertainGC :: Int -> String
 entertainGC 0 = "0"
-entertainGC x = show x ++ entertainGC (x -1)
+entertainGC x = show x ++ entertainGC (x - 1)
 
 testSize :: HasCallStack => SetupFunction -> Int -> IO ()
 testSize setup expectedSize = do
@@ -461,7 +463,10 @@ unboxSingletonTuple :: (# StackSnapshot# #) -> StackSnapshot#
 unboxSingletonTuple (# s# #) = s#
 
 minBigBitmapBits :: Num a => a
-minBigBitmapBits = 1 + fromIntegral maxSmallBitmapBits_c
+minBigBitmapBits = 1 + maxSmallBitmapBits
+
+maxSmallBitmapBits :: Num a => a
+maxSmallBitmapBits = fromIntegral maxSmallBitmapBits_c
 
 -- | A function with 59 arguments
 --



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffa315219d7d537e32863d35f3f41acbbfb44692

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ffa315219d7d537e32863d35f3f41acbbfb44692
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/20230210/60ed9542/attachment-0001.html>