diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2020-11-18 11:57:24 +0000 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-03-03 19:10:47 +0000 |
| commit | db80a5cc239d7d2a9c6f5259a782b99f8a4d8e41 (patch) | |
| tree | 41ab39c6f78eac1660afbde53a09f06d2dbbafd6 /testsuite | |
| parent | 9087899e36015bcc0142700a89c368bbc3da4b81 (diff) | |
| download | haskell-db80a5cc239d7d2a9c6f5259a782b99f8a4d8e41.tar.gz | |
Add test for whereFrom#
Diffstat (limited to 'testsuite')
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"] |