diff --git a/Cabal-tests/tests/UnitTests/Distribution/Simple/Command.hs b/Cabal-tests/tests/UnitTests/Distribution/Simple/Command.hs index ed93409e938..042341e9a62 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Simple/Command.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Simple/Command.hs @@ -4,8 +4,9 @@ module UnitTests.Distribution.Simple.Command import Distribution.Simple.Command import qualified Distribution.Simple.Flag as Flag -import Distribution.Simple.Setup (optionVerbosity) +import Distribution.Simple.Setup (optionVerbosity, testOptions, testCommand, splitArgs) import qualified Distribution.Verbosity as Verbosity +import Distribution.Simple.InstallDirs (toPathTemplate) import Test.Tasty import Test.Tasty.HUnit @@ -13,18 +14,35 @@ argumentTests :: [TestTree] argumentTests = [ testCase "parses verbosity successfully" $ do let p = commandParseArgs cmdUI isGlobal ["-v2"] - assertEqual "expected verbose" (Right verbose) $ evalParse p + assertEqual "expected verbose" (Right verbose) $ evalParseWith Flag.NoFlag p , testCase "handles argument parse error gracefully" $ do let p = commandParseArgs cmdUI isGlobal ["-v=2"] - assertEqual "expected error" (Left "errors") $ evalParse p + assertEqual "expected error" (Left "errors") $ evalParseWith Flag.NoFlag p + , testCase "handles test-options successfully" $ do + let p = commandParseArgs testCommand isGlobal ["--test-options=-p 'find root'"] + assertEqual "expected test options split" (Right $ fmap toPathTemplate ["-p", "find root"]) $ + (fmap testOptions (evalParseWith (commandDefaultFlags testCommand) p)) + , testCase "handles test-options successfully" $ do + let p = commandParseArgs testCommand isGlobal ["--test-options=-p \"find root\""] + assertEqual "expected test options split" (Right $ fmap toPathTemplate ["-p", "find root"]) $ + (fmap testOptions (evalParseWith (commandDefaultFlags testCommand) p)) + , testCase "handle quoted things sensibly in options" $ + assertEqual "expect options to be split" ["--foo=C:/Program Files/Bar/", "--baz"] $ + splitArgs "--foo=\"C:/Program Files/Bar/\" --baz" + , testCase "handle quoted things sensibly in options" $ + assertEqual "expect options to be split" ["-DMSGSTR=\"foo bar\"", "--baz"] $ + splitArgs "\"-DMSGSTR=\\\"foo bar\\\"\" --baz" + , testCase "handle quoted things sensibly in options" $ + assertEqual "expect options to be split" ["-p", "find root"] $ + splitArgs "-p 'find root'" ] where -- evaluate command parse result, to force possible exceptions in 'f' - evalParse p = case p of + evalParseWith fs p = case p of CommandErrors _ -> Left "errors" CommandHelp _ -> Left "help" CommandList _ -> Left "list" - CommandReadyToGo (f, _) -> Right $ f Flag.NoFlag + CommandReadyToGo (f, _) -> Right $ f fs verbose = Flag.Flag Verbosity.verbose isGlobal = True cmdUI = CommandUI diff --git a/Cabal/src/Distribution/Simple/Setup.hs b/Cabal/src/Distribution/Simple/Setup.hs index 6540d1e3685..1b14f93c48e 100644 --- a/Cabal/src/Distribution/Simple/Setup.hs +++ b/Cabal/src/Distribution/Simple/Setup.hs @@ -2262,11 +2262,11 @@ configureProg verbosity programDb prog = do -- | Helper function to split a string into a list of arguments. -- It's supposed to handle quoted things sensibly, eg: -- --- > splitArgs "--foo=\"C:/Program Files/Bar/" --baz" --- > = ["--foo=C:/Program Files/Bar", "--baz"] +-- >>> splitArgs "--foo=\"C:/Program Files/Bar/" --baz" +-- ["--foo=C:/Program Files/Bar", "--baz"] -- --- > splitArgs "\"-DMSGSTR=\\\"foo bar\\\"\" --baz" --- > = ["-DMSGSTR=\"foo bar\"","--baz"] +-- >>> splitArgs "\"-DMSGSTR=\\\"foo bar\\\"\" --baz" +-- ["-DMSGSTR=\"foo bar\"","--baz"] -- splitArgs :: String -> [String] splitArgs = space [] @@ -2276,8 +2276,14 @@ splitArgs = space [] space w ( c :s) | isSpace c = word w (space [] s) space w ('"':s) = string w s + space w ('\'':s) = singlyQuotedString w s space w s = nonstring w s + singlyQuotedString :: String -> String -> [String] + singlyQuotedString w [] = word w [] + singlyQuotedString w ('\'':s) = space w s + singlyQuotedString w (c:s) = singlyQuotedString (c:w) s + string :: String -> String -> [String] string w [] = word w [] string w ('"':s) = space w s @@ -2286,6 +2292,7 @@ splitArgs = space [] nonstring :: String -> String -> [String] nonstring w [] = word w [] + nonstring w ('\'':s) = singlyQuotedString w s nonstring w ('"':s) = string w s nonstring w ( c :s) = space (c:w) s