[Git][ghc/ghc][wip/fendor/ifacetype-deduplication] Introduce regression tests for `.hi` file sizes

[Hannes Siebenhandl (@fendor)]

Hannes Siebenhandl pushed to branch wip/fendor/ifacetype-deduplication at Glasgow Haskell Compiler / GHC


Commits:
b0a2f3eb by Matthew Pickering at 2024-05-13T14:11:48+02:00
Introduce regression tests for `.hi` file sizes

Add regression tests to track how `-fwrite-if-compression` levels affect
the size of `.hi` files.

- - - - -


8 changed files:

- + testsuite/tests/iface/IfaceSharingIfaceType.hs
- + testsuite/tests/iface/IfaceSharingName.hs
- + testsuite/tests/iface/Lib.hs
- + testsuite/tests/iface/Makefile
- + testsuite/tests/iface/all.T
- + testsuite/tests/iface/if_faststring.hs
- + testsuite/tests/iface/if_ifacetype.hs
- + testsuite/tests/iface/if_name.hs


Changes:

=====================================
testsuite/tests/iface/IfaceSharingIfaceType.hs
=====================================
@@ -0,0 +1,44 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module IfaceSharingIfaceType (types) where
+
+import GHC.Data.FastString
+import GHC.Builtin.Uniques
+import GHC.Builtin.Names
+import GHC.Builtin.Types
+import GHC.Types.Name
+import GHC.Types.SrcLoc
+import GHC.Iface.Type
+import GHC.CoreToIface
+import GHC.Core.TyCo.Rep
+import GHC
+
+[f1,f2,f3,f4,f5] = map mkVarOcc ["a", "b","c","d","e"]
+
+[u1,u2,u3,u4,u5] = map mkPreludeMiscIdUnique [10000..10004]
+
+names = [ mkExternalName u1 pRELUDE f1 noSrcSpan
+        , mkExternalName u2 pRELUDE f2 noSrcSpan
+        , mkExternalName u3 pRELUDE f3 noSrcSpan
+        , mkExternalName u4 pRELUDE f4 noSrcSpan
+        , mkExternalName u5 pRELUDE f5 noSrcSpan ]
+
+-- Int
+intIfaceTy = toIfaceType intTy
+
+wordIfaceTy = toIfaceType wordTy
+
+listIntTy = toIfaceType (mkListTy intTy)
+
+funTy = (intTy `mkVisFunTyMany` wordTy `mkVisFunTyMany` mkListTy intTy)
+
+funIfaceTy = toIfaceType funTy
+
+reallyBigFunTy = toIfaceType (funTy `mkVisFunTyMany` funTy `mkVisFunTyMany` funTy `mkVisFunTyMany` funTy)
+
+forallIfaceTy = toIfaceType (dataConType justDataCon)
+
+
+types = [intIfaceTy, wordIfaceTy, listIntTy, funIfaceTy, reallyBigFunTy, forallIfaceTy]
+


=====================================
testsuite/tests/iface/IfaceSharingName.hs
=====================================
@@ -0,0 +1,21 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module IfaceSharingName where
+
+import Lib
+import GHC.Data.FastString
+import GHC.Builtin.Uniques
+import GHC.Builtin.Names
+import GHC.Types.Name
+import GHC.Types.SrcLoc
+
+[f1,f2,f3,f4,f5] = map mkVarOcc ["a", "b","c","d","e"]
+
+[u1,u2,u3,u4,u5] = map mkPreludeMiscIdUnique [10000..10004]
+
+names = [ mkExternalName u1 pRELUDE f1 noSrcSpan
+        , mkExternalName u2 pRELUDE f2 noSrcSpan
+        , mkExternalName u3 pRELUDE f3 noSrcSpan
+        , mkExternalName u4 pRELUDE f4 noSrcSpan
+        , mkExternalName u5 pRELUDE f5 noSrcSpan ]


=====================================
testsuite/tests/iface/Lib.hs
=====================================
@@ -0,0 +1,15 @@
+module Lib where
+
+import GHC.Utils.Binary
+import GHC.Iface.Binary
+import qualified Data.ByteString as B
+import System.Environment
+import Data.Maybe
+
+testSize :: Binary a => CompressionIFace -> a -> IO Int
+testSize compLvl payload = do
+  args <- getArgs
+  bh <- openBinMem 1024
+  putWithUserData QuietBinIFace compLvl bh payload
+  withBinBuffer bh (\b -> return (B.length b))
+


=====================================
testsuite/tests/iface/Makefile
=====================================
@@ -0,0 +1,4 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+


=====================================
testsuite/tests/iface/all.T
=====================================
@@ -0,0 +1,24 @@
+test( 'if_faststring'
+    , [ stat_from_file('if_compression(1)', 5, 'NORMALSIZE')
+      , stat_from_file('if_compression(2)', 5, 'MEDIUMSIZE')
+      , stat_from_file('if_compression(3)', 5, 'FULLSIZE')
+      , extra_files(["Lib.hs"])]
+    , compile_and_run
+    , ['-package ghc'])
+
+test( 'if_name'
+    , [ stat_from_file('if_compression(1)', 5, 'NORMALSIZE')
+      , stat_from_file('if_compression(2)', 5, 'MEDIUMSIZE')
+      , stat_from_file('if_compression(3)', 5, 'FULLSIZE')
+      , extra_files(["Lib.hs", "IfaceSharingName.hs"])]
+    , compile_and_run
+    , ['-package ghc'])
+
+test( 'if_ifacetype'
+    , [ stat_from_file('if_compression(1)', 5, 'NORMALSIZE')
+      , stat_from_file('if_compression(2)', 5, 'MEDIUMSIZE')
+      , stat_from_file('if_compression(3)', 5, 'FULLSIZE')
+      , extra_files(["Lib.hs", "IfaceSharingIfaceType.hs"])]
+    , compile_and_run
+    , ['-package ghc'])
+


=====================================
testsuite/tests/iface/if_faststring.hs
=====================================
@@ -0,0 +1,15 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+import Lib
+import GHC.Data.FastString
+import GHC.Iface.Binary
+
+main :: IO ()
+main = do
+  sz <- testSize MaximalCompression (concat (replicate 1000 ["abc", "cde", "efg" :: FastString]))
+  writeFile "FULLSIZE" (show sz)
+  sz <- testSize SafeExtraCompression (concat (replicate 1000 ["abc", "cde", "efg" :: FastString]))
+  writeFile "MEDIUMSIZE" (show sz)
+  sz <- testSize NormalCompression (concat (replicate 1000 ["abc", "cde", "efg" :: FastString]))
+  writeFile "NORMALSIZE" (show sz)


=====================================
testsuite/tests/iface/if_ifacetype.hs
=====================================
@@ -0,0 +1,13 @@
+import Lib
+import IfaceSharingIfaceType
+import GHC.Iface.Binary
+
+main :: IO ()
+main = do
+  sz <- testSize MaximalCompression (concat (replicate 500 types))
+  writeFile "FULLSIZE" (show sz)
+  sz <- testSize SafeExtraCompression (concat (replicate 500 types))
+  writeFile "MEDIUMSIZE" (show sz)
+  sz <- testSize NormalCompression (concat (replicate 500 types))
+  writeFile "NORMALSIZE" (show sz)
+


=====================================
testsuite/tests/iface/if_name.hs
=====================================
@@ -0,0 +1,12 @@
+import Lib
+import IfaceSharingName
+import GHC.Iface.Binary
+
+main :: IO ()
+main = do
+  sz <- testSize MaximalCompression (concat (replicate 1000 names))
+  writeFile "FULLSIZE" (show sz)
+  sz <- testSize SafeExtraCompression (concat (replicate 1000 names))
+  writeFile "MEDIUMSIZE" (show sz)
+  sz <- testSize NormalCompression (concat (replicate 1000 names))
+  writeFile "NORMALSIZE" (show sz)



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b0a2f3eb587f47f00f3c0b3bddc9e70822233e52
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/20240513/6d529824/attachment-0001.html>