From 47d18b0b387fbfe07e1b4fbda578a81a74ab0eeb Mon Sep 17 00:00:00 2001
From: Andreas Klebinger <klebinger.andreas@gmx.at>
Date: Mon, 4 Apr 2022 19:31:40 +0200
Subject: Add regression test for #19569

---
 testsuite/tests/simplCore/should_run/T19569.hs     | 51 ++++++++++++++++++++++
 testsuite/tests/simplCore/should_run/T19569.stdout |  1 +
 testsuite/tests/simplCore/should_run/all.T         |  1 +
 3 files changed, 53 insertions(+)
 create mode 100644 testsuite/tests/simplCore/should_run/T19569.hs
 create mode 100644 testsuite/tests/simplCore/should_run/T19569.stdout

(limited to 'testsuite/tests')

diff --git a/testsuite/tests/simplCore/should_run/T19569.hs b/testsuite/tests/simplCore/should_run/T19569.hs
new file mode 100644
index 0000000000..bffef2c6df
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T19569.hs
@@ -0,0 +1,51 @@
+-- This is the integral benchmark from the nofib benchmark suite.
+-- In the past there have been issues with numeric stability for this benchmark (see #19569)
+-- so I added it to testsuite to catch such regressions in the future.
+
+-- It might be acceptable for this test to fail if you make changes to the simplifier. But generally such a failure shouldn't be accepted without good reason.
+
+-- The excessive whitespace is the result of running the original benchmark which was a .lhs file through unlit.
+
+module Main (integrate1D, main) where
+
+import System.Environment
+
+integrate1D :: Double -> Double -> (Double->Double) -> Double
+integrate1D l u f =
+  let  d = (u-l)/8.0 in
+     d * sum
+      [ (f l)*0.5,
+        f (l+d),
+        f (l+(2.0*d)),
+        f (l+(3.0*d)),
+        f (l+(4.0*d)),
+        f (u-(3.0*d)),
+        f (u-(2.0*d)),
+        f (u-d),
+        (f u)*0.5]
+
+integrate2D l1 u1 l2 u2 f = integrate1D l2 u2
+            (\y->integrate1D l1 u1
+              (\x->f x y))
+
+zark u v = integrate2D 0.0 u 0.0 v (\x->(\y->x*y))
+
+-- type signature required for compilers lacking the monomorphism restriction
+ints = [1.0..] :: [Double]
+zarks = zipWith zark ints (map (2.0*) ints)
+rtotals = head zarks : zipWith (+) (tail zarks) rtotals
+rtotal n = rtotals!!n
+
+is = map (^4) ints
+itotals = head is : zipWith (+) (tail is) itotals
+itotal n = itotals!!n
+
+es = map (^2) (zipWith (-) rtotals itotals)
+etotal n = sum (take n es)
+
+-- The (analytical) result should be zero
+main = do
+  [with_output,range] <- getArgs
+  if (read with_output)
+    then putStrLn $ show $ etotal $ read range
+    else seq (etotal $ read range) (putStrLn "Exact result hidden for lack of stability.\nPass 'True' as first argument to the benchmark if you want to view the computed output for testing purposes.")
diff --git a/testsuite/tests/simplCore/should_run/T19569.stdout b/testsuite/tests/simplCore/should_run/T19569.stdout
new file mode 100644
index 0000000000..25a207288c
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T19569.stdout
@@ -0,0 +1 @@
+1.9105614312239304e29
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index c8daab50eb..54ec5b8bff 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -97,6 +97,7 @@ test('NumConstantFolding16', normal, compile_and_run, [''])
 test('NumConstantFolding32', normal, compile_and_run, [''])
 test('NumConstantFolding', normal, compile_and_run, [''])
 test('T19413', normal, compile_and_run, [''])
+test('T19569', [only_ways(['optasm']),extra_run_opts('True 1000000')], compile_and_run, ['-O2'])
 test('T20203', normal, compile, ['-O -dsuppress-all -dsuppress-uniques -dno-typeable-binds -ddump-simpl'])
 test('T19313', normal, compile_and_run, [''])
 test('UnliftedArgRule', normal, compile_and_run, [''])
-- 
cgit v1.2.1