testsuite: add the rts_clearMemory test case

This patch adds a standalone test case for rts_clearMemory that mimics
how it's typically used by wasm backend users and ensures this RTS API
isn't broken by future RTS refactorings. Fixes #23901.

5 files changed, 43 insertions, 0 deletions

diff --git a/testsuite/.gitignore b/testsuite/.gitignore
index 76980608c2..2c699cf046 100644
--- a/testsuite/.gitignore
+++ b/testsuite/.gitignore
@@ -732,6 +732,7 @@ mk/ghcconfig*_test___spaces_ghc*.exe.mk
 /tests/ffi/should_run/ffi021
 /tests/ffi/should_run/ffi022
 /tests/ffi/should_run/ffi023
+/tests/ffi/should_run/rts_clearMemory
 /tests/ffi/should_run/ffi_parsing_001
 /tests/ffi/should_run/fptr01
 /tests/ffi/should_run/fptr02
diff --git a/testsuite/tests/ffi/should_run/Makefile b/testsuite/tests/ffi/should_run/Makefile
index f49712a90b..033eb576e1 100644
--- a/testsuite/tests/ffi/should_run/Makefile
+++ b/testsuite/tests/ffi/should_run/Makefile
@@ -25,6 +25,9 @@ T5594_setup :
 ffi023_setup :
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c ffi023.hs
 
+rts_clearMemory_setup :
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c rts_clearMemory.hs
+
 .PHONY: Capi_Ctype_001
 Capi_Ctype_001:
 	'$(HSC2HS)' Capi_Ctype_A_001.hsc
diff --git a/testsuite/tests/ffi/should_run/all.T b/testsuite/tests/ffi/should_run/all.T
index 7bed07bec9..8e1dff7b31 100644
--- a/testsuite/tests/ffi/should_run/all.T
+++ b/testsuite/tests/ffi/should_run/all.T
@@ -199,6 +199,18 @@ test('ffi023', [ omit_ways(['ghci']),
                 # needs it.
               compile_and_run, ['ffi023_c.c'])
 
+test('rts_clearMemory', [
+     # We only care about different GC configurations under the
+     # single-threaded RTS for the time being.
+     only_ways(['normal', 'optasm' ,'g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']),
+     extra_ways(['g1', 'nursery_chunks', 'nonmoving', 'compacting_gc']),
+     # On windows, nonmoving way fails with bad exit code (2816)
+     when(opsys('mingw32'), fragile(23091)),
+     js_broken(22363),
+     pre_cmd('$MAKE -s --no-print-directory rts_clearMemory_setup') ],
+     # Same hack as ffi023
+     compile_and_run, ['rts_clearMemory_c.c -no-hs-main'])
+
 test('T12134', [omit_ways(['ghci']), req_c], compile_and_run, ['T12134_c.c'])
 
 test('T12614', [omit_ways(['ghci']), req_c], compile_and_run, ['T12614_c.c'])
diff --git a/testsuite/tests/ffi/should_run/rts_clearMemory.hs b/testsuite/tests/ffi/should_run/rts_clearMemory.hs
new file mode 100644
index 0000000000..4ab0dac62d
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/rts_clearMemory.hs
@@ -0,0 +1,15 @@
+module RtsClearMemory
+  ( foo,
+  )
+where
+
+import Control.DeepSeq
+import Control.Exception
+import Data.Functor
+
+-- | Behold, mortal! This function doth summon forth a horde of trash,
+-- mere playthings for the garbage collector's insatiable appetite.
+foo :: Int -> IO ()
+foo n = void $ evaluate $ force [0 .. n]
+
+foreign export ccall foo :: Int -> IO ()
diff --git a/testsuite/tests/ffi/should_run/rts_clearMemory_c.c b/testsuite/tests/ffi/should_run/rts_clearMemory_c.c
new file mode 100644
index 0000000000..0dc46baccc
--- /dev/null
+++ b/testsuite/tests/ffi/should_run/rts_clearMemory_c.c
@@ -0,0 +1,12 @@
+#include <Rts.h>
+#include "rts_clearMemory_stub.h"
+
+int main(int argc, char *argv[]) {
+  hs_init_with_rtsopts(&argc, &argv);
+
+  for (int i = 0; i < 8; ++i) {
+    foo(1000000);
+    hs_perform_gc();
+    rts_clearMemory();
+  }
+}