From 355b1b18e2ff0ae751f684c91517281799d71b52 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Tue, 24 Apr 2012 09:47:24 +0100
Subject: [PATCH] Test Trac #5997

---
 testsuite/tests/simplCore/should_run/T5997.hs | 27 +++++++++++++++++++
 .../tests/simplCore/should_run/T5997.stdout   |  1 +
 testsuite/tests/simplCore/should_run/all.T    |  2 ++
 3 files changed, 30 insertions(+)
 create mode 100644 testsuite/tests/simplCore/should_run/T5997.hs
 create mode 100644 testsuite/tests/simplCore/should_run/T5997.stdout

diff --git a/testsuite/tests/simplCore/should_run/T5997.hs b/testsuite/tests/simplCore/should_run/T5997.hs
new file mode 100644
index 0000000000..cd0f1dda8b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T5997.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+incompleteBetaWorker :: Double -> Double
+incompleteBetaWorker _ = loop 1 1 1 1
+  where
+    -- Constants
+    eps = 1e-15
+    -- Loop
+    loop :: Double -> Int -> Double -> Double -> Double
+    loop !psq !ns !term !betain
+      | done           = betain'
+      | ns > 10000000  = betain'
+      | otherwise      = loop psq' (ns + 1) term' betain'
+      where
+        -- New values
+        term'   = term
+        betain' = betain
+        psq'    = if ns < 0 then psq + 1 else psq
+        -- This condition cause stack overflow
+        done = db <= eps && db <= eps*betain' where db = abs term'
+        -- With this it loops endlessly
+        -- done = db <= eps * betain' where db = abs term'
+
+main :: IO ()
+main = print $ incompleteBetaWorker 0
diff --git a/testsuite/tests/simplCore/should_run/T5997.stdout b/testsuite/tests/simplCore/should_run/T5997.stdout
new file mode 100644
index 0000000000..d3827e75a5
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T5997.stdout
@@ -0,0 +1 @@
+1.0
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 20b25787a0..210618a90a 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -55,3 +55,5 @@ test('T5625', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run,
 test('T5587', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, [''])
 test('T5915', only_ways(['normal','optasm']), compile_and_run, [''])
 test('T5920', only_ways(['normal','optasm']), compile_and_run, [''])
+test('T5997', normal, compile_and_run, [''])
+
-- 
GitLab