4 files changed, 98 insertions, 0 deletions
diff --git a/testsuite/tests/driver/j-space/Makefile b/testsuite/tests/driver/j-space/Makefile
new file mode 100644
index 0000000000..0e65cc72a6
--- /dev/null
+++ b/testsuite/tests/driver/j-space/Makefile
@@ -0,0 +1,9 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+jspace:
+	./genJspace
+	"$(TEST_HC)" $(TEST_HC_OPTS) -Wall -Werror -v0 jspace.hs -rtsopts -package ghc -threaded
+	./jspace$(exeext) +RTS -N -hT --no-automatic-heap-samples -RTS "`'$(TEST_HC)' --print-libdir | tr -d '\r'`"
+
diff --git a/testsuite/tests/driver/j-space/all.T b/testsuite/tests/driver/j-space/all.T
new file mode 100644
index 0000000000..7864ebf73a
--- /dev/null
+++ b/testsuite/tests/driver/j-space/all.T
@@ -0,0 +1 @@
+test('jspace', [extra_files(['genJspace']), req_smp], makefile_test, ['jspace'])
diff --git a/testsuite/tests/driver/j-space/genJspace b/testsuite/tests/driver/j-space/genJspace
new file mode 100755
index 0000000000..3056883367
--- /dev/null
+++ b/testsuite/tests/driver/j-space/genJspace
@@ -0,0 +1,33 @@
+#!/usr/bin/env bash
+# Generates the following module graph:
+#   - A module cycle H_d - ... - H_1 - H_0 - H_d-boot.
+#   - A w-wide collection of modules W_1 ... W_w all importing a common module W.
+#   - A module J importing H_d and all of W_1, ..., W_w.
+# This module graph makes it so that GHC has to compile one of the W_i modules at the same time
+# as it is compiling the loop of H modules.
+DEPTH=8
+WIDTH=40
+echo "module JSpaceTest where" > JSpaceTest.hs
+echo "module W where" > W.hs
+  for j in $(seq -w 1 300); do
+    echo "w$j = 123" >> W.hs;
+  done
+for i in $(seq -w 1 $WIDTH); do
+  echo "module W$i where" > W$i.hs;
+  echo "import W" >> W$i.hs;
+  echo "import W$i" >> JSpaceTest.hs;
+  for j in $(seq -w 1 1000); do
+    echo "w$j = 123" >> W$i.hs;
+  done
+done
+echo "module H0 where" > H0.hs;
+echo "import {-# SOURCE #-} H$DEPTH" >> H0.hs;
+echo "import H$DEPTH" >> JSpaceTest.hs;
+for i in $(seq -w 1 $DEPTH); do
+  echo "module H$i where" > H$i.hs;
+  echo "import H$((i-1))" >> H$i.hs;
+  for j in $(seq -w 1 100); do
+    echo "h$j = 123" >> H$i.hs;
+  done
+done
+echo "module H$DEPTH where" > H$DEPTH.hs-boot;
diff --git a/testsuite/tests/driver/j-space/jspace.hs b/testsuite/tests/driver/j-space/jspace.hs
new file mode 100644
index 0000000000..d8a4fc9779
--- /dev/null
+++ b/testsuite/tests/driver/j-space/jspace.hs
@@ -0,0 +1,55 @@
+module Main where
+
+import GHC
+import GHC.Driver.Monad
+import System.Environment
+import GHC.Driver.Env.Types
+import GHC.Profiling
+import System.Mem
+import Data.List (isPrefixOf)
+import Control.Monad
+import System.Exit
+import GHC.Platform
+
+main :: IO ()
+main = do
+    [libdir] <- getArgs
+    runGhc (Just libdir) $ do
+      initGhcM ["JSpaceTest.hs", "-O", "-j", "-v0"]
+
+
+initGhcM :: [String] -> Ghc ()
+initGhcM xs = do
+    session <- getSession
+    df1 <- getSessionDynFlags
+    let cmdOpts = ["-fforce-recomp"] ++ xs
+    (df2, leftovers, _) <- parseDynamicFlags (hsc_logger session) df1 (map noLoc cmdOpts)
+    setSessionDynFlags df2
+    ts <- mapM (\s -> guessTarget s Nothing Nothing) $ map unLoc leftovers
+    setTargets ts
+    _ <- load LoadAllTargets
+    let plat :: Platform
+        plat = targetPlatform df2
+        word_size = case platformWordSize plat of
+                      PW8 -> 8
+                      PW4 -> 4
+    liftIO $ do
+      requestHeapCensus
+      performGC
+      [ys] <- filter (isPrefixOf "ghc:GHC.Unit.Module.ModDetails.ModDetails") . lines <$> readFile "jspace.hp"
+      let (n :: Int) = read (last (words ys))
+      -- The output should be 50 * 8 * word_size (i.e. 3200, or 1600 on 32-bit architectures):
+      -- the test contains DEPTH + WIDTH + 2 = 50 modules J, H_0, .., H_DEPTH, W_1, .., W_WIDTH,
+      -- and each ModDetails contains 1 (info table) + 7 word-sized fields.
+      -- If this number changes DO NOT ACCEPT THE TEST, you have introduced a space leak.
+      --
+      -- There is some unexplained behaviour where the result is infrequently 3264.. but
+      -- this resisted investigation using ghc-debug so the test actually checks whether there
+      -- are less than 51 live ModDetails which is still a big improvement over before.
+      when (n >= (51 * word_size * 8)) $ do
+        putStrLn "Space leak detetched by jspace test:"
+        putStrLn $ (show (n `div` (word_size * 8))) ++ " live ModDetails when <= 51 are expected"
+        exitFailure
+    return ()
+
+