6 files changed, 194 insertions, 0 deletions
diff --git a/testsuite/tests/perf/compiler/Makefile b/testsuite/tests/perf/compiler/Makefile
index 20f5704450..0011c70710 100644
--- a/testsuite/tests/perf/compiler/Makefile
+++ b/testsuite/tests/perf/compiler/Makefile
@@ -16,3 +16,15 @@ T11068:
 MultiModulesRecomp:
 	./genMultiLayerModules
 	'$(TEST_HC)' $(TEST_HC_OPTS) -v0 MultiLayerModules.hs
+
+MultiComponentModulesRecomp:
+	'$(PYTHON)' genMultiComp.py
+	TEST_HC='$(TEST_HC)' TEST_HC_OPTS='$(TEST_HC_OPTS)' ./run
+
+MultiLayerModulesTH_Make_Prep:
+	./genMultiLayerModulesTH
+	"$(TEST_HC)" $(TEST_HC_OPTS) MultiLayerModulesPrep -dynamic-too -v0
+
+MultiLayerModulesTH_OneShot_Prep: MultiLayerModulesTH_Make_Prep
+	$(CP) MultiLayerModules.hs MultiLayerModulesTH_OneShot.hs
+
diff --git a/testsuite/tests/perf/compiler/MultiLayerModulesTH_Make.stderr b/testsuite/tests/perf/compiler/MultiLayerModulesTH_Make.stderr
new file mode 100644
index 0000000000..4a1b876638
--- /dev/null
+++ b/testsuite/tests/perf/compiler/MultiLayerModulesTH_Make.stderr
@@ -0,0 +1,8 @@
+
+MultiLayerModules.hs:334:8: error:
+    • Exception when trying to run compile-time code:
+        deliberate error
+CallStack (from HasCallStack):
+  error, called at MultiLayerModules.hs:334:10 in main:MultiLayerModules
+      Code: (error "deliberate error")
+    • In the untyped splice: $(error "deliberate error")
diff --git a/testsuite/tests/perf/compiler/MultiLayerModulesTH_OneShot.stderr b/testsuite/tests/perf/compiler/MultiLayerModulesTH_OneShot.stderr
new file mode 100644
index 0000000000..a958aceeea
--- /dev/null
+++ b/testsuite/tests/perf/compiler/MultiLayerModulesTH_OneShot.stderr
@@ -0,0 +1,8 @@
+
+MultiLayerModulesTH_OneShot.hs:334:8: error:
+    • Exception when trying to run compile-time code:
+        deliberate error
+CallStack (from HasCallStack):
+  error, called at MultiLayerModulesTH_OneShot.hs:334:10 in main:MultiLayerModules
+      Code: (error "deliberate error")
+    • In the untyped splice: $(error "deliberate error")
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index 2f52209d06..25672bf7e7 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -293,6 +293,29 @@ test('MultiLayerModulesRecomp',
      multimod_compile,
      ['MultiLayerModules', '-v0'])
 
+
+# A performance test for calculating link dependencies in --make mode.
+test('MultiLayerModulesTH_Make',
+     [ collect_compiler_stats('bytes allocated',3),
+       pre_cmd('$MAKE -s --no-print-directory MultiLayerModulesTH_Make_Prep'),
+       extra_files(['genMultiLayerModulesTH']),
+       unless(have_dynamic(),skip),
+       compile_timeout_multiplier(5)
+     ],
+     multimod_compile_fail,
+     ['MultiLayerModules', '-v0'])
+
+# A performance test for calculating link dependencies in -c mode.
+test('MultiLayerModulesTH_OneShot',
+     [ collect_compiler_stats('bytes allocated',3),
+       pre_cmd('$MAKE -s --no-print-directory MultiLayerModulesTH_OneShot_Prep'),
+       extra_files(['genMultiLayerModulesTH']),
+       unless(have_dynamic(),skip),
+       compile_timeout_multiplier(5)
+     ],
+     compile_fail,
+     ['-v0'])
+
 test('MultiLayerModulesDefsGhci',
      [ collect_compiler_residency(15),
        pre_cmd('./genMultiLayerModulesDefs'),
@@ -319,6 +342,24 @@ test('MultiLayerModulesNoCode',
      ghci_script,
      ['MultiLayerModulesNoCode.script'])
 
+test('MultiComponentModulesRecomp',
+     [ collect_compiler_stats('bytes allocated', 2),
+       pre_cmd('$MAKE -s --no-print-directory MultiComponentModulesRecomp'),
+       extra_files(['genMultiComp.py']),
+       compile_timeout_multiplier(5)
+     ],
+     multiunit_compile,
+     [['unitp%d' % n for n in range(20)], '-fno-code -fwrite-interface -v0'])
+
+test('MultiComponentModules',
+     [ collect_compiler_stats('bytes allocated', 2),
+       pre_cmd('$PYTHON ./genMultiComp.py'),
+       extra_files(['genMultiComp.py']),
+       compile_timeout_multiplier(5)
+     ],
+     multiunit_compile,
+     [['unitp%d' % n for n in range(20)], '-fno-code -fwrite-interface -v0'])
+
 test('ManyConstructors',
      [ collect_compiler_stats('bytes allocated',2),
        pre_cmd('./genManyConstructors'),
diff --git a/testsuite/tests/perf/compiler/genMultiComp.py b/testsuite/tests/perf/compiler/genMultiComp.py
new file mode 100755
index 0000000000..d069f77959
--- /dev/null
+++ b/testsuite/tests/perf/compiler/genMultiComp.py
@@ -0,0 +1,78 @@
+#! /usr/bin/env python
+
+# Generates a set of interdependent units for testing any obvious performance cliffs
+# with multiple component support.
+# The structure of each unit is:
+# * A Top module, which imports the rest of the modules in the unit
+# * A number of modules names Mod_<pid>_<mid>, each module imports all the top
+#   modules beneath it, and all the modules in the current unit beneath it.
+
+import os
+import stat
+
+modules_per = 20
+packages = 20
+total = modules_per * packages
+
+def unit_dir(p):
+    return "p" + str(p)
+
+def unit_fname(p):
+    return "unitp" + str(p)
+
+def top_fname(p):
+    return "Top" + str(p)
+
+def mod_name(p, k):
+    return "Mod_%d_%d" % (p, k)
+
+def flatten(t):
+    return [item for sublist in t for item in sublist]
+
+def mk_unit_file(p):
+    fname = top_fname(p)
+    deps = flatten([["-package-id", unit_dir(k)] for k in range(p)])
+    opts = ["-working-dir", unit_dir(p), "-this-unit-id", unit_dir(p), fname] + deps
+    with open(unit_fname(p), 'w') as fout:
+        fout.write(' '.join(opts))
+
+def mk_top_mod(p):
+    pdir = unit_dir(p)
+    topfname = os.path.join(pdir, top_fname(p) + '.hs')
+    header = 'module %s where' % top_fname(p)
+    imports = ['import %s' % mod_name(p, m) for m in range(modules_per)]
+    with open(topfname, 'w') as fout:
+        fout.write(header + '\n')
+        fout.write('\n'.join(imports))
+
+def mk_mod(p, k):
+    pdir = unit_dir(p)
+    fname = os.path.join(pdir, mod_name(p, k) + '.hs')
+    header = 'module %s where' % mod_name(p,k)
+    imports1 = ['import ' + top_fname(pn) for pn in range(p)]
+    imports2 = ['import ' + mod_name(p, kn) for kn in range(k)]
+    with open(fname, 'w') as fout:
+        fout.write(header + '\n')
+        fout.write('\n'.join(imports1))
+        fout.write('\n')
+        fout.write('\n'.join(imports2))
+
+def mk_run():
+    all_units = flatten([['-unit', '@'+unit_fname(pn)] for pn in range(packages)])
+    with open('run', 'w') as fout:
+        fout.write("$TEST_HC $TEST_HC_OPTS -fno-code -fwrite-interface ")
+        fout.write(" ".join(all_units))
+
+    st = os.stat('run')
+    os.chmod('run', st.st_mode | stat.S_IEXEC)
+
+
+for p in range(packages):
+    os.mkdir(unit_dir(p))
+    mk_unit_file(p)
+    mk_top_mod(p)
+    for k in range(modules_per):
+        mk_mod(p, k)
+mk_run()
+
+
diff --git a/testsuite/tests/perf/compiler/genMultiLayerModulesTH b/testsuite/tests/perf/compiler/genMultiLayerModulesTH
new file mode 100755
index 0000000000..2781871fa6
--- /dev/null
+++ b/testsuite/tests/perf/compiler/genMultiLayerModulesTH
@@ -0,0 +1,47 @@
+#!/usr/bin/env bash
+# Generate $DEPTH layers of modules with $WIDTH modules on each layer
+# Every module on layer N imports all the modules on layer N-1
+# MultiLayerModulesPrep.hs imports all the modules from the last layer, is used to
+# prepare all dependencies.
+# MultiLayerModules.hs imports all the modules from the last layer, and has NDEFS*WIDTH
+# top-level splices which stress some inefficient parts of link dependency calculation.
+# Lastly there is a splice which contains an error so that we don't benchmark code
+# generation as well.
+
+DEPTH=10
+WIDTH=30
+NDEFS=10
+for i in $(seq -w 1 $WIDTH); do
+  echo "module DummyLevel0M$i where" > DummyLevel0M$i.hs;
+done
+for l in $(seq 1 $DEPTH); do
+  for i in $(seq -w 1 $WIDTH); do
+    echo "module DummyLevel${l}M$i where" > DummyLevel${l}M$i.hs;
+    for j in $(seq -w 1 $WIDTH); do
+      echo "import DummyLevel$((l-1))M$j" >> DummyLevel${l}M$i.hs;
+    done
+    echo "def_${l}_${i} :: Int" >> DummyLevel${l}M$i.hs;
+    echo "def_${l}_${i} = ${l} * ${i}" >> DummyLevel${l}M${i}.hs;
+  done
+done
+# Gen the prep module, which can be compiled without running and TH splices
+# but forces the rest of the project to be built.
+echo "module MultiLayerModulesPrep where" > MultiLayerModulesPrep.hs
+for j in $(seq -w 1 $WIDTH); do
+  echo "import DummyLevel${DEPTH}M$j" >> MultiLayerModulesPrep.hs;
+done
+
+echo "{-# LANGUAGE TemplateHaskell #-}" > MultiLayerModules.hs
+echo "module MultiLayerModules where" >> MultiLayerModules.hs
+echo "import Language.Haskell.TH.Syntax" >> MultiLayerModules.hs
+for j in $(seq -w 1 $WIDTH); do
+  echo "import DummyLevel${DEPTH}M$j" >> MultiLayerModules.hs;
+done
+for j in $(seq -w 1 $WIDTH); do
+  for i in $(seq -w 1 $NDEFS); do
+  echo "defth_${j}_${i} = \$(lift def_${DEPTH}_${j})"  >> MultiLayerModules.hs;
+  done
+done
+# Finally, a splice with an error so we stop before doing code generation
+# This
+echo "last = \$(error \"deliberate error\")" >> MultiLayerModules.hs