summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2022-04-04 19:31:40 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-04-09 13:03:35 -0400
commit47d18b0b387fbfe07e1b4fbda578a81a74ab0eeb (patch)
tree66f5aaa49de454e3cb9a41416469caa1d900a3ac
parent20bbf3ace6bda71b28154bec3e840e418440eac0 (diff)
downloadhaskell-47d18b0b387fbfe07e1b4fbda578a81a74ab0eeb.tar.gz
Add regression test for #19569
-rw-r--r--testsuite/tests/simplCore/should_run/T19569.hs51
-rw-r--r--testsuite/tests/simplCore/should_run/T19569.stdout1
-rw-r--r--testsuite/tests/simplCore/should_run/all.T1
3 files changed, 53 insertions, 0 deletions
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, [''])