Repository : ssh://darcs.haskell.org//srv/darcs/testsuite On branch : master
http://hackage.haskell.org/trac/ghc/changeset/c7f3881871bf9c7989feefe313ae64da4a2f2057 >--------------------------------------------------------------- commit c7f3881871bf9c7989feefe313ae64da4a2f2057 Author: Simon Marlow <[email protected]> Date: Thu Dec 1 11:09:46 2011 +0000 Test for Debug.Trace.traceStack and GHC.Stack.whoCreated >--------------------------------------------------------------- tests/profiling/should_run/all.T | 3 +++ tests/profiling/should_run/callstack002.hs | 21 +++++++++++++++++++++ tests/profiling/should_run/callstack002.stderr | 16 ++++++++++++++++ tests/profiling/should_run/callstack002.stdout | 8 ++++++++ 4 files changed, 48 insertions(+), 0 deletions(-) diff --git a/tests/profiling/should_run/all.T b/tests/profiling/should_run/all.T index 9d6d58e..d1ac005 100644 --- a/tests/profiling/should_run/all.T +++ b/tests/profiling/should_run/all.T @@ -104,3 +104,6 @@ test('callstack001', [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], compile_and_run, ['']) +test('callstack002', + [ req_profiling, extra_ways(['prof']), only_ways(prof_ways) ], + compile_and_run, ['-fno-full-laziness -fno-state-hack']) diff --git a/tests/profiling/should_run/callstack002.hs b/tests/profiling/should_run/callstack002.hs new file mode 100644 index 0000000..437e2cb --- /dev/null +++ b/tests/profiling/should_run/callstack002.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE BangPatterns #-} +module Main where + +import Debug.Trace +import Text.Printf +import Prelude hiding (map) +import GHC.Stack + +f :: Int -> Int +f x = traceStack (printf "f: %d" x) (x * 2) + +map :: (a -> b) -> [a] -> [b] +map f xs = go xs + where go [] = [] + go (x:xs) = f x : map f xs + +main = do + let xs = map f [42,43] + print xs + putStrLn =<< renderStack `fmap` (whoCreated $! head xs) + diff --git a/tests/profiling/should_run/callstack002.stderr b/tests/profiling/should_run/callstack002.stderr new file mode 100644 index 0000000..b1eaf4f --- /dev/null +++ b/tests/profiling/should_run/callstack002.stderr @@ -0,0 +1,16 @@ +f: 42 +Stack trace: + Main.CAF + Main.main + Main.main.xs + Main.map + Main.map.go + Main.f +f: 43 +Stack trace: + Main.CAF + Main.main + Main.main.xs + Main.map + Main.map.go + Main.f diff --git a/tests/profiling/should_run/callstack002.stdout b/tests/profiling/should_run/callstack002.stdout new file mode 100644 index 0000000..a68ecf9 --- /dev/null +++ b/tests/profiling/should_run/callstack002.stdout @@ -0,0 +1,8 @@ +[84,86] +Stack trace: + Main.CAF + Main.main + Main.main.xs + Main.map + Main.map.go + Main.f _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
