The Haddock part for fully gcc-like response files

" driver/Main.hs
  * Moved the response file handling into ResponseFile.hs,
    updating import section as appropriate.
* driver/ResponseFile.hs
  * New file. In anticipation that maybe some day this could
    be provided by another library, and to make it possible
    to unit test, this functionality is pulled out of the
    Main.hs module, and expanded to support the style/format
    of response files which gcc uses.
  * The specification for the format of response files which
    gcc generates and consumes, seems to be best derived from
    the gcc code itself (libiberty/argv.c), so that is what
    has been done here.
  * This is intended to fix haskell/haddock#379
* driver-test/Main.hs
  * New file for testing code in the driver source tree
* driver-test/ResponseFileSpec.hs
  * Tests, adapted/adopted from the same gcc code where the
    escaping/unescaping is from, in the hspec style of unit
    tests
* haddock.cabal
  * Add the driver-test test-suite.  Introduces a new library
    dependency (upon hspec) for the haddock driver target in
    the haddock.cabal file, but practically, this should not
    be a problem as the haddock-api tests already depend on
    hspec.

2 files changed, 92 insertions, 0 deletions

diff --git a/driver-test/Main.hs b/driver-test/Main.hs
new file mode 100644
index 00000000..d3f636e9
--- /dev/null
+++ b/driver-test/Main.hs
@@ -0,0 +1,12 @@
+module Main where
+
+import Test.Hspec (describe, hspec, Spec)
+import qualified ResponseFileSpec (spec)
+
+
+main :: IO ()
+main = hspec spec
+
+spec :: Spec
+spec = do
+    describe "ResponseFile" ResponseFileSpec.spec
diff --git a/driver-test/ResponseFileSpec.hs b/driver-test/ResponseFileSpec.hs
new file mode 100644
index 00000000..997adac4
--- /dev/null
+++ b/driver-test/ResponseFileSpec.hs
@@ -0,0 +1,80 @@
+module ResponseFileSpec where
+
+import Test.Hspec (context, describe, it, shouldBe, Spec)
+import ResponseFile (escapeArgs, unescapeArgs)
+
+-- The first two elements are
+--   1) a list of 'args' to encode and
+--   2) a single string of the encoded args
+-- The 3rd element is just a description for the tests.
+testStrs :: [(([String], String), String)]
+testStrs =
+  [ ((["a simple command line"],
+      "a\\ simple\\ command\\ line\n"),
+     "the white-space, end with newline")
+
+  , ((["arg 'foo' is single quoted"],
+      "arg\\ \\'foo\\'\\ is\\ single\\ quoted\n"),
+     "the single quotes as well")
+
+  , ((["arg \"bar\" is double quoted"],
+      "arg\\ \\\"bar\\\"\\ is\\ double\\ quoted\n"),
+     "the double quotes as well" )
+
+  , ((["arg \"foo bar\" has embedded whitespace"],
+      "arg\\ \\\"foo\\ bar\\\"\\ has\\ embedded\\ whitespace\n"),
+     "the quote-embedded whitespace")
+
+  , ((["arg 'Jack said \\'hi\\'' has single quotes"],
+      "arg\\ \\'Jack\\ said\\ \\\\\\'hi\\\\\\'\\'\\ has\\ single\\ quotes\n"),
+     "the escaped single quotes")
+
+  , ((["arg 'Jack said \\\"hi\\\"' has double quotes"],
+      "arg\\ \\'Jack\\ said\\ \\\\\\\"hi\\\\\\\"\\'\\ has\\ double\\ quotes\n"),
+     "the escaped double quotes")
+
+  , ((["arg 'Jack said\\r\\n\\t \\\"hi\\\"' has other whitespace"],
+      "arg\\ \\'Jack\\ said\\\\r\\\\n\\\\t\\ \\\\\\\"hi\\\\\\\"\\'\\ has\\ \
+           \other\\ whitespace\n"),
+     "the other whitespace")
+
+  , (([ "--prologue=.\\dist\\.\\haddock-prologue3239114604.txt"
+      , "--title=HaddockNewline-0.1.0.0: This has a\n\
+        \newline yo."
+      , "-BC:\\Program Files\\Haskell Platform\\lib"],
+      "--prologue=.\\\\dist\\\\.\\\\haddock-prologue3239114604.txt\n\
+      \--title=HaddockNewline-0.1.0.0:\\ This\\ has\\ a\\\n\
+      \newline\\ yo.\n\
+      \-BC:\\\\Program\\ Files\\\\Haskell\\ Platform\\\\lib\n"),
+     "an actual haddock response file snippet with embedded newlines")
+  ]
+
+spec :: Spec
+spec = do
+  describe "escapeArgs" $ do
+      mapM_ (\((ss1,s2),des) -> do
+                  context ("given " ++ (show ss1)) $ do
+                      it ("should escape " ++ des) $ do
+                          escapeArgs ss1 `shouldBe` s2
+            ) testStrs
+  describe "unescapeArgs" $ do
+      mapM_ (\((ss1,s2),des) -> do
+                  context ("given " ++ (show s2)) $ do
+                      it ("should unescape " ++ des) $ do
+                          unescapeArgs s2 `shouldBe` ss1
+            ) testStrs
+  describe "unescapeArgs" $ do
+      context "given unescaped single quotes" $ do
+          it "should pass-through, without escaping, everything inside" $ do
+              -- backslash *always* is escaped anywhere it appears
+              (filter (not . null) $
+                unescapeArgs "this\\ is\\ 'not escape\\d \"inside\"'\\ yo\n")
+              `shouldBe`
+              ["this is not escaped \"inside\" yo"]
+      context "given unescaped double quotes" $ do
+          it "should pass-through, without escaping, everything inside" $ do
+              -- backslash *always* is escaped anywhere it appears
+              (filter (not . null) $
+                unescapeArgs "this\\ is\\ \"not escape\\d 'inside'\"\\ yo\n")
+              `shouldBe`
+              ["this is not escaped 'inside' yo"]