Improve test-suite, merging in GHC tests
authorDavid Terei <code@davidterei.com>
Fri, 26 Dec 2014 07:58:45 +0000 (23:58 -0800)
committerDavid Terei <code@davidterei.com>
Fri, 26 Dec 2014 08:02:04 +0000 (00:02 -0800)
pretty.cabal
tests/BugSep.hs
tests/T3911.hs [deleted file]
tests/T3911.stdout [deleted file]
tests/Test.hs
tests/TestUtils.hs [new file with mode: 0644]
tests/UnitPP1.hs [new file with mode: 0644]
tests/UnitT3911.hs [new file with mode: 0644]
tests/all.T [deleted file]
tests/pp1.hs [deleted file]
tests/pp1.stdout [deleted file]

index e97ac11..104803e 100644 (file)
@@ -49,6 +49,8 @@ Test-Suite test-pretty
     other-modules:
         TestGenerators
         TestStructures
+        UnitPP1
+        UnitT3911
     extensions: CPP, BangPatterns, DeriveGeneric
     include-dirs: src/Text/PrettyPrint
 
index 2047480..fe16b80 100644 (file)
@@ -1,3 +1,6 @@
+-- | Demonstration of ambiguity in HughesPJ library at this time. GHC's
+-- internal copy has a different answer than we currently do, preventing them
+-- using our library.
 module Main (main) where
 
 import Text.PrettyPrint.HughesPJ
diff --git a/tests/T3911.hs b/tests/T3911.hs
deleted file mode 100644 (file)
index 01ccb22..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-
-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/tests/T3911.stdout b/tests/T3911.stdout
deleted file mode 100644 (file)
index 7677e8d..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-hello     world
-hello     world
-hello
-          world
index 51f659d..107e32a 100644 (file)
@@ -1,4 +1,3 @@
-{-# OPTIONS -XStandaloneDeriving -XDeriveDataTypeable -XPackageImports #-}
 -----------------------------------------------------------------------------
 -- Module      :  HughesPJQuickCheck
 -- Copyright   :  (c) 2008 Benedikt Huber
@@ -16,6 +15,9 @@ import PrettyTestVersion
 import TestGenerators
 import TestStructures
 
+import UnitPP1
+import UnitT3911
+
 import Control.Monad
 import Data.Char (isSpace)
 import Data.List (intersperse)
@@ -31,6 +33,8 @@ main = do
     check_non_prims -- hpc full coverage
     check_rendering
     check_list_def
+    testPP1
+    testT3911
 
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 -- Utility functions
diff --git a/tests/TestUtils.hs b/tests/TestUtils.hs
new file mode 100644 (file)
index 0000000..24ef7c7
--- /dev/null
@@ -0,0 +1,19 @@
+-- | Test-suite framework and utility functions.
+module TestUtils (
+    simpleMatch
+  ) where
+
+import Control.Monad
+import System.Exit
+
+simpleMatch :: String -> String -> String -> IO ()
+simpleMatch test expected actual =
+  when (actual /= expected) $ do
+    putStrLn $ "Test `" ++ test ++ "' failed!"
+    putStrLn "-----------------------------"
+    putStrLn $ "Expected: " ++ expected
+    putStrLn "-----------------------------"
+    putStrLn $ "Actual: " ++ actual
+    putStrLn "-----------------------------"
+    exitFailure
+
diff --git a/tests/UnitPP1.hs b/tests/UnitPP1.hs
new file mode 100644 (file)
index 0000000..31217c4
--- /dev/null
@@ -0,0 +1,76 @@
+-- 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 UnitPP1 where
+
+import TestUtils
+
+import Text.PrettyPrint.HughesPJ
+
+ncat :: Doc -> Doc -> Doc
+ncat x y = nest 4 $ cat [ x, y ]
+
+d1, d2 :: Doc
+d1 = foldl1 ncat $ take 50 $ repeat $ char 'a'
+d2 = parens $  sep [ d1, text "+" , d1 ]
+
+testPP1 :: IO ()
+testPP1 = simpleMatch "PP1" expected out
+  where out = show d2
+
+expected :: String
+expected =
+  "(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\n\
++                                                                                                                                                                                                   a\n\
+ a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a\n\
+a)"
+
diff --git a/tests/UnitT3911.hs b/tests/UnitT3911.hs
new file mode 100644 (file)
index 0000000..39aa1e2
--- /dev/null
@@ -0,0 +1,25 @@
+module UnitT3911 where
+
+import Text.PrettyPrint.HughesPJ
+
+import TestUtils
+
+xs :: [Doc]
+xs = [text "hello",
+      nest 10 (text "world")]
+
+d1, d2, d3 :: Doc
+d1 = vcat xs
+d2 = foldr ($$) empty xs
+d3 = foldr ($+$) empty xs
+
+testT3911 :: IO ()
+testT3911 = simpleMatch "T3911" expected out
+  where out = show d1 ++ "\n" ++ show d2 ++ "\n" ++ show d3
+
+expected :: String
+expected =
+  "hello     world\n\
+hello     world\n\
+hello\n\
+          world"
diff --git a/tests/all.T b/tests/all.T
deleted file mode 100644 (file)
index 81e2c73..0000000
+++ /dev/null
@@ -1,2 +0,0 @@
-test('pp1', [expect_broken(1062), only_ways(['normal'])], compile_and_run, [''])
-test('T3911', normal, compile_and_run, [''])
diff --git a/tests/pp1.hs b/tests/pp1.hs
deleted file mode 100644 (file)
index 384d565..0000000
+++ /dev/null
@@ -1,18 +0,0 @@
--- 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/tests/pp1.stdout b/tests/pp1.stdout
deleted file mode 100644 (file)
index 6915311..0000000
+++ /dev/null
@@ -1,4 +0,0 @@
-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