From d510c45790432249fe7027b1ed70ce1c06fdd824 Mon Sep 17 00:00:00 2001 From: randen Date: Fri, 1 Jan 2016 18:02:11 -0800 Subject: 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. --- driver-test/Main.hs | 12 +++++++ driver-test/ResponseFileSpec.hs | 80 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 92 insertions(+) create mode 100644 driver-test/Main.hs create mode 100644 driver-test/ResponseFileSpec.hs (limited to 'driver-test') 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"] -- cgit v1.2.3