From 1e63a6fb59628a2fa2ee46e88e562df804973535 Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Tue, 9 Apr 2024 14:57:09 +0100
Subject: [PATCH] Introduce regression tests for `.hi` file sizes
Add regression tests to track how `-fwrite-if-compression` levels affect
the size of `.hi` files.
---
.../tests/iface/IfaceSharingIfaceType.hs | 44 +++++++++++++++++++
testsuite/tests/iface/IfaceSharingName.hs | 21 +++++++++
testsuite/tests/iface/Lib.hs | 15 +++++++
testsuite/tests/iface/Makefile | 4 ++
testsuite/tests/iface/all.T | 24 ++++++++++
testsuite/tests/iface/if_faststring.hs | 15 +++++++
testsuite/tests/iface/if_ifacetype.hs | 13 ++++++
testsuite/tests/iface/if_name.hs | 12 +++++
8 files changed, 148 insertions(+)
create mode 100644 testsuite/tests/iface/IfaceSharingIfaceType.hs
create mode 100644 testsuite/tests/iface/IfaceSharingName.hs
create mode 100644 testsuite/tests/iface/Lib.hs
create mode 100644 testsuite/tests/iface/Makefile
create mode 100644 testsuite/tests/iface/all.T
create mode 100644 testsuite/tests/iface/if_faststring.hs
create mode 100644 testsuite/tests/iface/if_ifacetype.hs
create mode 100644 testsuite/tests/iface/if_name.hs
diff --git a/testsuite/tests/iface/IfaceSharingIfaceType.hs b/testsuite/tests/iface/IfaceSharingIfaceType.hs
new file mode 100644
index 000000000000..49de148fa3a7
--- /dev/null
+++ b/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]
+
diff --git a/testsuite/tests/iface/IfaceSharingName.hs b/testsuite/tests/iface/IfaceSharingName.hs
new file mode 100644
index 000000000000..2ae7d447013e
--- /dev/null
+++ b/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 ]
diff --git a/testsuite/tests/iface/Lib.hs b/testsuite/tests/iface/Lib.hs
new file mode 100644
index 000000000000..7dafbfd41dd6
--- /dev/null
+++ b/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))
+
diff --git a/testsuite/tests/iface/Makefile b/testsuite/tests/iface/Makefile
new file mode 100644
index 000000000000..77b32358b525
--- /dev/null
+++ b/testsuite/tests/iface/Makefile
@@ -0,0 +1,4 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
diff --git a/testsuite/tests/iface/all.T b/testsuite/tests/iface/all.T
new file mode 100644
index 000000000000..b4388d541005
--- /dev/null
+++ b/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'])
+
diff --git a/testsuite/tests/iface/if_faststring.hs b/testsuite/tests/iface/if_faststring.hs
new file mode 100644
index 000000000000..6afa28382bf5
--- /dev/null
+++ b/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 MaximumCompression (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)
diff --git a/testsuite/tests/iface/if_ifacetype.hs b/testsuite/tests/iface/if_ifacetype.hs
new file mode 100644
index 000000000000..ed53e592e938
--- /dev/null
+++ b/testsuite/tests/iface/if_ifacetype.hs
@@ -0,0 +1,13 @@
+import Lib
+import IfaceSharingIfaceType
+import GHC.Iface.Binary
+
+main :: IO ()
+main = do
+ sz <- testSize MaximumCompression (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)
+
diff --git a/testsuite/tests/iface/if_name.hs b/testsuite/tests/iface/if_name.hs
new file mode 100644
index 000000000000..7049c13d528c
--- /dev/null
+++ b/testsuite/tests/iface/if_name.hs
@@ -0,0 +1,12 @@
+import Lib
+import IfaceSharingName
+import GHC.Iface.Binary
+
+main :: IO ()
+main = do
+ sz <- testSize MaximumCompression (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)
--
GitLab