Repository : ssh://darcs.haskell.org//srv/darcs/packages/pretty On branch : master
http://hackage.haskell.org/trac/ghc/changeset/0eb1ee0034ffc730335daf392b0a7be9aaec335d >--------------------------------------------------------------- commit 0eb1ee0034ffc730335daf392b0a7be9aaec335d Author: David Terei <[email protected]> Date: Mon Mar 5 20:19:16 2012 -0800 Add tests from GHC. >--------------------------------------------------------------- test/T3911.hs | 23 +++++++++++++++++++++++ test/T3911.stdout | 4 ++++ test/all.T | 2 ++ test/pp1.hs | 18 ++++++++++++++++++ test/pp1.stdout | 4 ++++ 5 files changed, 51 insertions(+), 0 deletions(-) diff --git a/test/T3911.hs b/test/T3911.hs new file mode 100644 index 0000000..01ccb22 --- /dev/null +++ b/test/T3911.hs @@ -0,0 +1,23 @@ + +module Main where + +import Text.PrettyPrint.HughesPJ + +xs :: [Doc] +xs = [text "hello", + nest 10 (text "world")] + +d1 :: Doc +d1 = vcat xs + +d2 :: Doc +d2 = foldr ($$) empty xs + +d3 :: Doc +d3 = foldr ($+$) empty xs + +main :: IO () +main = do print d1 + print d2 + print d3 + diff --git a/test/T3911.stdout b/test/T3911.stdout new file mode 100644 index 0000000..7677e8d --- /dev/null +++ b/test/T3911.stdout @@ -0,0 +1,4 @@ +hello world +hello world +hello + world diff --git a/test/all.T b/test/all.T new file mode 100644 index 0000000..5189843 --- /dev/null +++ b/test/all.T @@ -0,0 +1,2 @@ +test('pp1', compose(expect_broken(1062), only_ways(['normal'])), compile_and_run, ['']) +test('T3911', normal, compile_and_run, ['']) diff --git a/test/pp1.hs b/test/pp1.hs new file mode 100644 index 0000000..384d565 --- /dev/null +++ b/test/pp1.hs @@ -0,0 +1,18 @@ +-- This code used to print an infinite string, by calling 'spaces' +-- with a negative argument. There's a patch in the library now, +-- which makes 'spaces' do something sensible when called with a negative +-- argument, but it really should not happen at all. + + +module Main where + +import Text.PrettyPrint.HughesPJ + + +ncat x y = nest 4 $ cat [ x, y ] + +d1 = foldl1 ncat $ take 50 $ repeat $ char 'a' +d2 = parens $ sep [ d1, text "+" , d1 ] + +main = print d2 + diff --git a/test/pp1.stdout b/test/pp1.stdout new file mode 100644 index 0000000..6915311 --- /dev/null +++ b/test/pp1.stdout @@ -0,0 +1,4 @@ +This output is not what is expected, becuase the +test "works" now, by virtue of a hack in HughesPJ.spaces. +I'm leaving this strange output here to remind us to look +at the root cause of the problem. Sometime. \ No newline at end of file _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
