Add test for whereFrom#

5 files changed, 51 insertions, 0 deletions

diff --git a/testsuite/tests/profiling/should_run/all.T b/testsuite/tests/profiling/should_run/all.T
index 9f1fa67e1e..d82d739172 100644
--- a/testsuite/tests/profiling/should_run/all.T
+++ b/testsuite/tests/profiling/should_run/all.T
@@ -14,6 +14,17 @@ test('dynamic-prof2', [only_ways(['normal']), extra_run_opts('+RTS -hT --no-auto
 
 test('dynamic-prof3', [only_ways(['normal']), extra_run_opts('+RTS -hT --no-automatic-heap-samples')], compile_and_run, [''])
 
+test('staticcallstack001',
+     [ omit_ways(['ghci-ext-prof']), # produces a different stack
+     ], compile_and_run,
+     ['-O0 -g3 -fdistinct-constructor-tables -finfo-table-map'])
+
+test('staticcallstack002',
+     [ omit_ways(['ghci-ext-prof']), # produces a different stack
+     ], compile_and_run,
+     ['-O0 -g3 -fdistinct-constructor-tables -finfo-table-map'])
+
+
 # Below this line, run tests only with profiling ways.
 setTestOpts(req_profiling)
 setTestOpts(extra_ways(['prof', 'ghci-ext-prof']))
diff --git a/testsuite/tests/profiling/should_run/staticcallstack001.hs b/testsuite/tests/profiling/should_run/staticcallstack001.hs
new file mode 100644
index 0000000000..78849d0ef1
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/staticcallstack001.hs
@@ -0,0 +1,19 @@
+module Main where
+
+import GHC.Stack.CCS
+
+data D = D Int deriving Show
+
+ff = id (D 5)
+{-# NOINLINE ff #-}
+{-# NOINLINE qq #-}
+
+qq x = D x
+
+caf = D 5
+
+main = do
+  print . tail =<< whereFrom (D 5)
+  print . tail =<< whereFrom caf
+  print . tail =<< whereFrom (id (D 5))
+
diff --git a/testsuite/tests/profiling/should_run/staticcallstack001.stdout b/testsuite/tests/profiling/should_run/staticcallstack001.stdout
new file mode 100644
index 0000000000..7da74c81d9
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/staticcallstack001.stdout
@@ -0,0 +1,3 @@
+["2","D","main","Main","staticcallstack001.hs:16:20-34"]
+["2","D","caf","Main","staticcallstack001.hs:13:1-9"]
+["15","D","main","Main","staticcallstack001.hs:18:30-39"]
diff --git a/testsuite/tests/profiling/should_run/staticcallstack002.hs b/testsuite/tests/profiling/should_run/staticcallstack002.hs
new file mode 100644
index 0000000000..87df13bee0
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/staticcallstack002.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE UnboxedTuples #-}
+module Main where
+
+import GHC.Stack.CCS
+
+-- Unboxed data constructors don't have info tables so there is
+-- a special case to not generate distinct info tables for unboxed
+-- constructors.
+main = do
+  print . tail =<< whereFrom (undefined (# #))
+  print . tail =<< whereFrom (undefined (# () #))
+  print . tail =<< whereFrom (undefined (# (), () #))
+  print . tail =<< whereFrom (undefined (# | () #))
+
diff --git a/testsuite/tests/profiling/should_run/staticcallstack002.stdout b/testsuite/tests/profiling/should_run/staticcallstack002.stdout
new file mode 100644
index 0000000000..c96b6fa7f3
--- /dev/null
+++ b/testsuite/tests/profiling/should_run/staticcallstack002.stdout
@@ -0,0 +1,4 @@
+["15","Any","main","Main","staticcallstack002.hs:10:30-46"]
+["15","Any","main","Main","staticcallstack002.hs:11:30-49"]
+["15","Any","main","Main","staticcallstack002.hs:12:30-53"]
+["15","Any","main","Main","staticcallstack002.hs:13:30-51"]