From 593f4e04844a714553eaa859c405abc58881f0c7 Mon Sep 17 00:00:00 2001
From: Fendor <fendor@posteo.de>
Date: Wed, 17 Apr 2024 13:45:52 +0200
Subject: [PATCH] Add performance regression test for '-fwrite-simplified-core'
---
testsuite/tests/perf/compiler/Makefile | 6 ++++
.../MultiLayerModulesDefsGhciWithCore.script | 1 +
testsuite/tests/perf/compiler/all.T | 14 ++++++++++
.../perf/compiler/genMultiLayerModulesCore | 28 +++++++++++++++++++
4 files changed, 49 insertions(+)
create mode 100644 testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithCore.script
create mode 100755 testsuite/tests/perf/compiler/genMultiLayerModulesCore
diff --git a/testsuite/tests/perf/compiler/Makefile b/testsuite/tests/perf/compiler/Makefile
index 06f9ac130412..667217d5ee55 100644
--- a/testsuite/tests/perf/compiler/Makefile
+++ b/testsuite/tests/perf/compiler/Makefile
@@ -17,6 +17,12 @@ MultiModulesRecomp:
./genMultiLayerModules
'$(TEST_HC)' $(TEST_HC_OPTS) -v0 MultiLayerModules.hs
+# -e "" exits the ghci session immediately and merely makes sure, we generated interface files
+# containing core expressions, aka `mi_extra_decls` are populated.
+MultiModulesRecompDefsWithCore:
+ ./genMultiLayerModulesCore
+ '$(TEST_HC)' --interactive $(TEST_HC_OPTS) -e "" -fwrite-if-simplified-core MultiLayerModules
+
MultiComponentModulesRecomp:
'$(PYTHON)' genMultiComp.py
TEST_HC='$(TEST_HC)' TEST_HC_OPTS='$(TEST_HC_OPTS)' ./run
diff --git a/testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithCore.script b/testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithCore.script
new file mode 100644
index 000000000000..05db28683541
--- /dev/null
+++ b/testsuite/tests/perf/compiler/MultiLayerModulesDefsGhciWithCore.script
@@ -0,0 +1 @@
+:m + MultiLayerModules
diff --git a/testsuite/tests/perf/compiler/all.T b/testsuite/tests/perf/compiler/all.T
index cfef36f9f436..37becfc2b18c 100644
--- a/testsuite/tests/perf/compiler/all.T
+++ b/testsuite/tests/perf/compiler/all.T
@@ -405,6 +405,20 @@ test('MultiLayerModulesDefsGhci',
ghci_script,
['MultiLayerModulesDefsGhci.script'])
+test('MultiLayerModulesDefsGhciWithCore',
+ [ collect_compiler_residency(15),
+ pre_cmd('$MAKE -s --no-print-directory MultiModulesRecompDefsWithCore'),
+ extra_files(['genMultiLayerModulesCore', 'MultiLayerModulesDefsGhciWithCore.script']),
+ compile_timeout_multiplier(5),
+ # this is _a lot_
+ # but this test has been failing every now and then,
+ # especially on i386. Let's just give it some room
+ # to complete successfully reliably everywhere.
+ extra_run_opts('-fwrite-if-simplified-core MultiLayerModules')
+ ],
+ ghci_script,
+ ['MultiLayerModulesDefsGhciWithCore.script'])
+
test('MultiLayerModulesDefsGhciReload',
[ collect_compiler_residency(15),
pre_cmd('./genMultiLayerModulesDefs'),
diff --git a/testsuite/tests/perf/compiler/genMultiLayerModulesCore b/testsuite/tests/perf/compiler/genMultiLayerModulesCore
new file mode 100755
index 000000000000..2c43c1143307
--- /dev/null
+++ b/testsuite/tests/perf/compiler/genMultiLayerModulesCore
@@ -0,0 +1,28 @@
+#!/usr/bin/env bash
+# Generate $WIDTH modules with one type each $FIELDS type variables.
+# The type has $CONSTRS constructors with each $FIELDS fields.
+# All types derive 'Generic' to generate a large amount of Types.
+# MultiLayerModules.hs imports all the modules
+WIDTH=10
+FIELDS=10
+CONSTRS=15
+FIELD_VARS=$(for field in $(seq -w 1 $FIELDS); do echo -n "a${field} "; done)
+for i in $(seq -w 1 $WIDTH); do
+ echo "module DummyLevel$i where" > DummyLevel$i.hs;
+ echo "import GHC.Generics" >> DummyLevel$i.hs;
+ echo "data Type_${i} ${FIELD_VARS}" >> DummyLevel$i.hs;
+ for constr in $(seq -w 1 $CONSTRS); do
+ if [ $constr -eq 1 ]; then
+ echo -n " = Constr_${i}_${constr} " >> DummyLevel$i.hs;
+ else
+ echo -n " | Constr_${i}_${constr} " >> DummyLevel$i.hs;
+ fi
+ echo ${FIELD_VARS} >> DummyLevel$i.hs;
+ done
+ echo " deriving (Show, Eq, Ord, Generic)" >> DummyLevel$i.hs;
+done
+
+echo "module MultiLayerModules where" > MultiLayerModules.hs
+for j in $(seq -w 1 $WIDTH); do
+ echo "import DummyLevel$j" >> MultiLayerModules.hs;
+done
--
GitLab