Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-hspec-core for openSUSE:Factory checked in at 2021-11-17 01:13:19 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hspec-core (Old) and /work/SRC/openSUSE:Factory/.ghc-hspec-core.new.1890 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-hspec-core" Wed Nov 17 01:13:19 2021 rev:23 rq:931399 version:2.8.4 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hspec-core/ghc-hspec-core.changes 2021-08-25 20:58:45.509117847 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hspec-core.new.1890/ghc-hspec-core.changes 2021-11-17 01:13:56.858165198 +0100 @@ -1,0 +2,6 @@ +Sun Nov 7 14:53:11 UTC 2021 - [email protected] + +- Update hspec-core to version 2.8.4. + Upstream does not provide a change log file. + +------------------------------------------------------------------- Old: ---- hspec-core-2.8.3.tar.gz New: ---- hspec-core-2.8.4.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hspec-core.spec ++++++ --- /var/tmp/diff_new_pack.wIol97/_old 2021-11-17 01:13:57.490165434 +0100 +++ /var/tmp/diff_new_pack.wIol97/_new 2021-11-17 01:13:57.494165436 +0100 @@ -19,7 +19,7 @@ %global pkg_name hspec-core %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.8.3 +Version: 2.8.4 Release: 0 Summary: A Testing Framework for Haskell License: MIT ++++++ hspec-core-2.8.3.tar.gz -> hspec-core-2.8.4.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/hspec-core.cabal new/hspec-core-2.8.4/hspec-core.cabal --- old/hspec-core-2.8.3/hspec-core.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/hspec-core.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hspec-core -version: 2.8.3 +version: 2.8.4 license: MIT license-file: LICENSE copyright: (c) 2011-2021 Simon Hengel, @@ -31,7 +31,7 @@ hs-source-dirs: src vendor - ghc-options: -Wall + ghc-options: -Wall -fno-warn-incomplete-uni-patterns build-depends: HUnit ==1.6.* , QuickCheck >=2.13.1 @@ -61,11 +61,16 @@ Test.Hspec.Core.QuickCheck Test.Hspec.Core.Util other-modules: + GetOpt.Declarative + GetOpt.Declarative.Environment + GetOpt.Declarative.Interpret + GetOpt.Declarative.Types + GetOpt.Declarative.Util Test.Hspec.Core.Clock Test.Hspec.Core.Compat Test.Hspec.Core.Config + Test.Hspec.Core.Config.Definition Test.Hspec.Core.Config.Options - Test.Hspec.Core.Config.Util Test.Hspec.Core.Example Test.Hspec.Core.Example.Location Test.Hspec.Core.FailureReport @@ -92,7 +97,7 @@ src vendor test - ghc-options: -Wall + ghc-options: -Wall -fno-warn-incomplete-uni-patterns cpp-options: -DTEST build-depends: HUnit ==1.6.* @@ -119,11 +124,16 @@ build-tool-depends: hspec-meta:hspec-meta-discover other-modules: + GetOpt.Declarative + GetOpt.Declarative.Environment + GetOpt.Declarative.Interpret + GetOpt.Declarative.Types + GetOpt.Declarative.Util Test.Hspec.Core.Clock Test.Hspec.Core.Compat Test.Hspec.Core.Config + Test.Hspec.Core.Config.Definition Test.Hspec.Core.Config.Options - Test.Hspec.Core.Config.Util Test.Hspec.Core.Example Test.Hspec.Core.Example.Location Test.Hspec.Core.FailureReport @@ -150,12 +160,14 @@ Control.Concurrent.Async Data.Algorithm.Diff All + GetOpt.Declarative.EnvironmentSpec + GetOpt.Declarative.UtilSpec Helper Mock Test.Hspec.Core.ClockSpec Test.Hspec.Core.CompatSpec + Test.Hspec.Core.Config.DefinitionSpec Test.Hspec.Core.Config.OptionsSpec - Test.Hspec.Core.Config.UtilSpec Test.Hspec.Core.ConfigSpec Test.Hspec.Core.Example.LocationSpec Test.Hspec.Core.ExampleSpec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/GetOpt/Declarative/Environment.hs new/hspec-core-2.8.4/src/GetOpt/Declarative/Environment.hs --- old/hspec-core-2.8.3/src/GetOpt/Declarative/Environment.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/src/GetOpt/Declarative/Environment.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,51 @@ +module GetOpt.Declarative.Environment ( + InvalidValue(..) +, parseEnvironmentOptions +, parseEnvironmentOption +) where + +import Prelude () +import Test.Hspec.Core.Compat +import Data.Char + +import GetOpt.Declarative.Types + +data InvalidValue = InvalidValue String String + deriving (Eq, Show) + +parseEnvironmentOptions :: String -> [(String, String)] -> config -> [Option config] -> ([InvalidValue], config) +parseEnvironmentOptions prefix env = foldr f . (,) [] + where + f :: Option config -> ([InvalidValue], config) -> ([InvalidValue], config) + f option (errs, config) = case parseEnvironmentOption prefix env config option of + Left err -> (err : errs, config) + Right c -> (errs, c) + +parseEnvironmentOption :: String -> [(String, String)] -> config -> Option config -> Either InvalidValue config +parseEnvironmentOption prefix env config option = case lookup name env of + Nothing -> Right config + Just value -> case optionSetter option of + NoArg setter -> case value of + "yes" -> Right $ setter config + _ -> invalidValue + Flag setter -> case value of + "yes" -> Right $ setter True config + "no" -> Right $ setter False config + _ -> invalidValue + OptArg _ setter -> case setter (Just value) config of + Just c -> Right c + Nothing -> invalidValue + Arg _ setter -> case setter value config of + Just c -> Right c + Nothing -> invalidValue + where + invalidValue = Left (InvalidValue name value) + where + name = envVarName prefix option + +envVarName :: String -> Option config -> String +envVarName prefix option = prefix ++ '_' : map f (optionName option) + where + f c = case c of + '-' -> '_' + _ -> toUpper c diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/GetOpt/Declarative/Interpret.hs new/hspec-core-2.8.4/src/GetOpt/Declarative/Interpret.hs --- old/hspec-core-2.8.3/src/GetOpt/Declarative/Interpret.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/src/GetOpt/Declarative/Interpret.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,97 @@ +module GetOpt.Declarative.Interpret ( + ParseResult(..) +, parseCommandLineOptions +, parse +, interpretOptions +) where + +import Prelude () +import Test.Hspec.Core.Compat +import Data.Maybe + +import System.Console.GetOpt (OptDescr, ArgOrder(..), getOpt) +import qualified System.Console.GetOpt as GetOpt + +import GetOpt.Declarative.Types +import GetOpt.Declarative.Util (mkUsageInfo, mapOptDescr) + +data InvalidArgument = InvalidArgument String String + +data ParseResult config = Help String | Failure String | Success config + +parseCommandLineOptions :: [(String, [Option config])] -> String -> [String] -> config -> ParseResult config +parseCommandLineOptions opts prog args config = case parseWithHelp (concatMap snd options) config args of + Nothing -> Help usage + Just (Right c) -> Success c + Just (Left err) -> Failure $ prog ++ ": " ++ err ++ "\nTry `" ++ prog ++ " --help' for more information.\n" + where + options = addHelpFlag $ map (fmap interpretOptions) opts + + documentedOptions = addHelpFlag $ map (fmap $ interpretOptions . filter optionDocumented) opts + + usage :: String + usage = "Usage: " ++ prog ++ " [OPTION]...\n\n" + ++ (intercalate "\n" $ map (uncurry mkUsageInfo) documentedOptions) + +addHelpFlag :: [(a, [OptDescr a1])] -> [(a, [OptDescr (Maybe a1)])] +addHelpFlag opts = case opts of + (section, xs) : ys -> (section, GetOpt.Option [] ["help"] (GetOpt.NoArg help) "display this help and exit" : noHelp xs) : map (fmap noHelp) ys + [] -> [] + where + help = Nothing + + noHelp :: [OptDescr a] -> [OptDescr (Maybe a)] + noHelp = map (mapOptDescr Just) + +parseWithHelp :: [OptDescr (Maybe (config -> Either InvalidArgument config))] -> config -> [String] -> Maybe (Either String config) +parseWithHelp options config args = case getOpt Permute options args of + (opts, [], []) | _ : _ <- [() | Nothing <- opts] -> Nothing + (opts, xs, ys) -> Just $ interpretResult config (catMaybes opts, xs, ys) + +parse :: [OptDescr (config -> Either InvalidArgument config)] -> config -> [String] -> Either String config +parse options config = interpretResult config . getOpt Permute options + +interpretResult :: config -> ([config -> Either InvalidArgument config], [String], [String]) -> Either String config +interpretResult config = interpretGetOptResult >=> foldResult config + +foldResult :: config -> [config -> Either InvalidArgument config] -> Either String config +foldResult config opts = either (Left . renderInvalidArgument) return $ foldlM (flip id) config opts + +renderInvalidArgument :: InvalidArgument -> String +renderInvalidArgument (InvalidArgument name value) = "invalid argument `" ++ value ++ "' for `--" ++ name ++ "'" + +interpretGetOptResult :: ([a], [String], [String]) -> Either String [a] +interpretGetOptResult result = case result of + (opts, [], []) -> Right opts + (_, _, err:_) -> Left (init err) + (_, arg:_, _) -> Left ("unexpected argument `" ++ arg ++ "'") + +interpretOptions :: [Option config] -> [OptDescr (config -> Either InvalidArgument config)] +interpretOptions = concatMap interpretOption + +interpretOption :: Option config -> [OptDescr (config -> Either InvalidArgument config)] +interpretOption (Option name shortcut argDesc help _) = case argDesc of + NoArg setter -> [option $ GetOpt.NoArg (Right . setter)] + + Flag setter -> [ + option (arg True) + , GetOpt.Option [] ["no-" ++ name] (arg False) ("do not " ++ help) + ] + where + arg v = GetOpt.NoArg (Right . setter v) + + OptArg argName setter -> [option $ GetOpt.OptArg arg argName] + where + arg mInput c = case setter mInput c of + Just c_ -> Right c_ + Nothing -> case mInput of + Just input -> invalid input + Nothing -> Right c + + Arg argName setter -> [option (GetOpt.ReqArg arg argName)] + where + arg input = maybe (invalid input) Right . setter input + + where + invalid = Left . InvalidArgument name + option arg = GetOpt.Option (maybeToList shortcut) [name] arg help diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/GetOpt/Declarative/Types.hs new/hspec-core-2.8.4/src/GetOpt/Declarative/Types.hs --- old/hspec-core-2.8.3/src/GetOpt/Declarative/Types.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/src/GetOpt/Declarative/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,18 @@ +module GetOpt.Declarative.Types where + +import Prelude () +import Test.Hspec.Core.Compat + +data Option config = Option { + optionName :: String +, optionShortcut :: Maybe Char +, optionSetter :: OptionSetter config +, optionHelp :: String +, optionDocumented :: Bool +} + +data OptionSetter config = + NoArg (config -> config) + | Flag (Bool -> config -> config) + | OptArg String (Maybe String -> config -> Maybe config) + | Arg String (String -> config -> Maybe config) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/GetOpt/Declarative/Util.hs new/hspec-core-2.8.4/src/GetOpt/Declarative/Util.hs --- old/hspec-core-2.8.3/src/GetOpt/Declarative/Util.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/src/GetOpt/Declarative/Util.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,47 @@ +{-# LANGUAGE CPP #-} +module GetOpt.Declarative.Util (mkUsageInfo, mapOptDescr) where + +import Prelude () +import Test.Hspec.Core.Compat + +import System.Console.GetOpt + +import Test.Hspec.Core.Util + +modifyHelp :: (String -> String) -> OptDescr a -> OptDescr a +modifyHelp modify (Option s n a help) = Option s n a (modify help) + +mkUsageInfo :: String -> [OptDescr a] -> String +mkUsageInfo title = usageInfo title . addLineBreaksForHelp . condenseNoOptions + +addLineBreaksForHelp :: [OptDescr a] -> [OptDescr a] +addLineBreaksForHelp options = map (modifyHelp addLineBreaks) options + where + withoutHelpWidth = maxLength . usageInfo "" . map removeHelp + helpWidth = 80 - withoutHelpWidth options + + addLineBreaks = unlines . lineBreaksAt helpWidth + + maxLength = maximum . map length . lines + removeHelp = modifyHelp (const "") + +condenseNoOptions :: [OptDescr a] -> [OptDescr a] +condenseNoOptions options = case options of + Option "" [optionA] arg help : Option "" [optionB] _ _ : ys | optionB == ("no-" ++ optionA) -> + Option "" ["[no-]" ++ optionA] arg help : condenseNoOptions ys + x : xs -> x : condenseNoOptions xs + [] -> [] + +mapOptDescr :: (a -> b) -> OptDescr a -> OptDescr b +#if MIN_VERSION_base(4,7,0) +mapOptDescr = fmap +#else +mapOptDescr f opt = case opt of + Option short long arg help -> Option short long (mapArgDescr f arg) help + +mapArgDescr :: (a -> b) -> ArgDescr a -> ArgDescr b +mapArgDescr f arg = case arg of + NoArg a -> NoArg (f a) + ReqArg parse name -> ReqArg (fmap f parse) name + OptArg parse name -> OptArg (fmap f parse) name +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/GetOpt/Declarative.hs new/hspec-core-2.8.4/src/GetOpt/Declarative.hs --- old/hspec-core-2.8.3/src/GetOpt/Declarative.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/src/GetOpt/Declarative.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,5 @@ +module GetOpt.Declarative (module GetOpt.Declarative) where +import Prelude () +import GetOpt.Declarative.Types as GetOpt.Declarative +import GetOpt.Declarative.Interpret as GetOpt.Declarative +import GetOpt.Declarative.Environment as GetOpt.Declarative diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/Test/Hspec/Core/Config/Definition.hs new/hspec-core-2.8.4/src/Test/Hspec/Core/Config/Definition.hs --- old/hspec-core-2.8.3/src/Test/Hspec/Core/Config/Definition.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/src/Test/Hspec/Core/Config/Definition.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,281 @@ +{-# LANGUAGE CPP #-} +module Test.Hspec.Core.Config.Definition ( + Config(..) +, ColorMode(..) +, filterOr +, defaultConfig + +, commandLineOnlyOptions +, formatterOptions +, smallCheckOptions +, quickCheckOptions +, runnerOptions + +#ifdef TEST +, formatOrList +#endif +) where + +import Prelude () +import Test.Hspec.Core.Compat + +import Test.Hspec.Core.Example (Params(..), defaultParams) +import Test.Hspec.Core.Format (Format, FormatConfig) +import qualified Test.Hspec.Core.Formatters.V1 as V1 +import qualified Test.Hspec.Core.Formatters.V2 as V2 +import Test.Hspec.Core.Util + +import GetOpt.Declarative + + +data ColorMode = ColorAuto | ColorNever | ColorAlways + deriving (Eq, Show) + +data Config = Config { + configIgnoreConfigFile :: Bool +, configDryRun :: Bool +, configFocusedOnly :: Bool +, configFailOnFocused :: Bool +, configPrintSlowItems :: Maybe Int +, configPrintCpuTime :: Bool +, configFastFail :: Bool +, configRandomize :: Bool +, configFailureReport :: Maybe FilePath +, configRerun :: Bool +, configRerunAllOnSuccess :: Bool + +-- | +-- A predicate that is used to filter the spec before it is run. Only examples +-- that satisfy the predicate are run. +, configFilterPredicate :: Maybe (Path -> Bool) +, configSkipPredicate :: Maybe (Path -> Bool) +, configQuickCheckSeed :: Maybe Integer +, configQuickCheckMaxSuccess :: Maybe Int +, configQuickCheckMaxDiscardRatio :: Maybe Int +, configQuickCheckMaxSize :: Maybe Int +, configQuickCheckMaxShrinks :: Maybe Int +, configSmallCheckDepth :: Int +, configColorMode :: ColorMode +, configDiff :: Bool +, configTimes :: Bool +, configFormat :: Maybe (FormatConfig -> IO Format) +, configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead +, configHtmlOutput :: Bool +, configConcurrentJobs :: Maybe Int +} + +defaultConfig :: Config +defaultConfig = Config { + configIgnoreConfigFile = False +, configDryRun = False +, configFocusedOnly = False +, configFailOnFocused = False +, configPrintSlowItems = Nothing +, configPrintCpuTime = False +, configFastFail = False +, configRandomize = False +, configFailureReport = Nothing +, configRerun = False +, configRerunAllOnSuccess = False +, configFilterPredicate = Nothing +, configSkipPredicate = Nothing +, configQuickCheckSeed = Nothing +, configQuickCheckMaxSuccess = Nothing +, configQuickCheckMaxDiscardRatio = Nothing +, configQuickCheckMaxSize = Nothing +, configQuickCheckMaxShrinks = Nothing +, configSmallCheckDepth = paramsSmallCheckDepth defaultParams +, configColorMode = ColorAuto +, configDiff = True +, configTimes = False +, configFormat = Nothing +, configFormatter = Nothing +, configHtmlOutput = False +, configConcurrentJobs = Nothing +} + +option :: String -> OptionSetter config -> String -> Option config +option name arg help = Option name Nothing arg help True + +mkFlag :: String -> (Bool -> Config -> Config) -> String -> Option Config +mkFlag name setter = option name (Flag setter) + +mkOptionNoArg :: String -> Maybe Char -> (Config -> Config) -> String -> Option Config +mkOptionNoArg name shortcut setter help = Option name shortcut (NoArg setter) help True + +mkOption :: String -> Maybe Char -> OptionSetter Config -> String -> Option Config +mkOption name shortcut arg help = Option name shortcut arg help True + +undocumented :: Option config -> Option config +undocumented opt = opt {optionDocumented = False} + +argument :: String -> (String -> Maybe a) -> (a -> Config -> Config) -> OptionSetter Config +argument name parser setter = Arg name $ \ input c -> flip setter c <$> parser input + +formatterOptions :: [Option Config] +formatterOptions = [ + mkOption "format" (Just 'f') (argument "FORMATTER" readFormatter setFormatter) helpForFormat + , mkFlag "color" setColor "colorize the output" + , mkFlag "diff" setDiff "show colorized diffs" + , mkFlag "times" setTimes "report times for individual spec items" + , mkOptionNoArg "print-cpu-time" Nothing setPrintCpuTime "include used CPU time in summary" + , printSlowItemsOption + + -- undocumented for now, as we probably want to change this to produce a + -- standalone HTML report in the future + , undocumented $ mkOptionNoArg "html" Nothing setHtml "produce HTML output" + ] + where + setHtml config = config {configHtmlOutput = True} + + formatters :: [(String, FormatConfig -> IO Format)] + formatters = map (fmap V2.formatterToFormat) [ + ("checks", V2.checks) + , ("specdoc", V2.specdoc) + , ("progress", V2.progress) + , ("failed-examples", V2.failed_examples) + , ("silent", V2.silent) + ] + + helpForFormat :: String + helpForFormat = "use a custom formatter; this can be one of " ++ (formatOrList $ map fst formatters) + + readFormatter :: String -> Maybe (FormatConfig -> IO Format) + readFormatter = (`lookup` formatters) + + setFormatter :: (FormatConfig -> IO Format) -> Config -> Config + setFormatter f c = c {configFormat = Just f} + + setColor :: Bool -> Config -> Config + setColor v config = config {configColorMode = if v then ColorAlways else ColorNever} + + setDiff :: Bool -> Config -> Config + setDiff v config = config {configDiff = v} + + setTimes :: Bool -> Config -> Config + setTimes v config = config {configTimes = v} + + setPrintCpuTime config = config {configPrintCpuTime = True} + +printSlowItemsOption :: Option Config +printSlowItemsOption = Option name (Just 'p') (OptArg "N" arg) "print the N slowest spec items (default: 10)" True + where + name = "print-slow-items" + + setter :: Maybe Int -> Config -> Config + setter v c = c {configPrintSlowItems = v} + + arg :: Maybe String -> Config -> Maybe Config + arg = maybe (Just . (setter $ Just 10)) parseArg + + parseArg :: String -> Config -> Maybe Config + parseArg input c = case readMaybe input of + Just 0 -> Just (setter Nothing c) + Just n -> Just (setter (Just n) c) + Nothing -> Nothing + +smallCheckOptions :: [Option Config] +smallCheckOptions = [ + option "depth" (argument "N" readMaybe setDepth) "maximum depth of generated test values for SmallCheck properties" + ] + +setDepth :: Int -> Config -> Config +setDepth n c = c {configSmallCheckDepth = n} + +quickCheckOptions :: [Option Config] +quickCheckOptions = [ + Option "qc-max-success" (Just 'a') (argument "N" readMaybe setMaxSuccess) "maximum number of successful tests before a QuickCheck property succeeds" True + , option "qc-max-discard" (argument "N" readMaybe setMaxDiscardRatio) "maximum number of discarded tests per successful test before giving up" + , option "qc-max-size" (argument "N" readMaybe setMaxSize) "size to use for the biggest test cases" + , option "qc-max-shrinks" (argument "N" readMaybe setMaxShrinks) "maximum number of shrinks to perform before giving up (a value of 0 turns shrinking off)" + , option "seed" (argument "N" readMaybe setSeed) "used seed for QuickCheck properties" + + -- for compatibility with test-framework + , undocumented $ option "maximum-generated-tests" (argument "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default" + ] + +setMaxSuccess :: Int -> Config -> Config +setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n} + +setMaxDiscardRatio :: Int -> Config -> Config +setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n} + +setMaxSize :: Int -> Config -> Config +setMaxSize n c = c {configQuickCheckMaxSize = Just n} + +setMaxShrinks :: Int -> Config -> Config +setMaxShrinks n c = c {configQuickCheckMaxShrinks = Just n} + +setSeed :: Integer -> Config -> Config +setSeed n c = c {configQuickCheckSeed = Just n} + +runnerOptions :: [Option Config] +runnerOptions = [ + mkFlag "dry-run" setDryRun "pretend that everything passed; don't verify anything" + , mkFlag "focused-only" setFocusedOnly "do not run anything, unless there are focused spec items" + , mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items" + , mkFlag "fail-fast" setFastFail "abort on first failure" + , mkFlag "randomize" setRandomize "randomize execution order" + , mkOptionNoArg "rerun" (Just 'r') setRerun "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)" + , option "failure-report" (argument "FILE" return setFailureReport) "read/write a failure report for use with --rerun" + , mkOptionNoArg "rerun-all-on-success" Nothing setRerunAllOnSuccess "run the whole test suite after a previously failing rerun succeeds for the first time (only works in combination with --rerun)" + , mkOption "jobs" (Just 'j') (argument "N" readMaxJobs setMaxJobs) "run at most N parallelizable tests simultaneously (default: number of available processors)" + ] + where + readMaxJobs :: String -> Maybe Int + readMaxJobs s = do + n <- readMaybe s + guard $ n > 0 + return n + + setFailureReport :: String -> Config -> Config + setFailureReport file c = c {configFailureReport = Just file} + + setMaxJobs :: Int -> Config -> Config + setMaxJobs n c = c {configConcurrentJobs = Just n} + + setDryRun :: Bool -> Config -> Config + setDryRun value config = config {configDryRun = value} + + setFocusedOnly :: Bool -> Config -> Config + setFocusedOnly value config = config {configFocusedOnly = value} + + setFailOnFocused :: Bool -> Config -> Config + setFailOnFocused value config = config {configFailOnFocused = value} + + setFastFail :: Bool -> Config -> Config + setFastFail value config = config {configFastFail = value} + + setRandomize :: Bool -> Config -> Config + setRandomize value config = config {configRandomize = value} + + setRerun config = config {configRerun = True} + setRerunAllOnSuccess config = config {configRerunAllOnSuccess = True} + +commandLineOnlyOptions :: [Option Config] +commandLineOnlyOptions = [ + mkOptionNoArg "ignore-dot-hspec" Nothing setIgnoreConfigFile "do not read options from ~/.hspec and .hspec" + , mkOption "match" (Just 'm') (argument "PATTERN" return addMatch) "only run examples that match given PATTERN" + , option "skip" (argument "PATTERN" return addSkip) "skip examples that match given PATTERN" + ] + where + setIgnoreConfigFile config = config {configIgnoreConfigFile = True} + +addMatch :: String -> Config -> Config +addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c} + +addSkip :: String -> Config -> Config +addSkip s c = c {configSkipPredicate = Just (filterPredicate s) `filterOr` configSkipPredicate c} + +filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool) +filterOr p1_ p2_ = case (p1_, p2_) of + (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path + _ -> p1_ <|> p2_ + +formatOrList :: [String] -> String +formatOrList xs = case xs of + [] -> "" + x : ys -> (case ys of + [] -> x + _ : [] -> x ++ " or " + _ : _ : _ -> x ++ ", ") ++ formatOrList ys diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/Test/Hspec/Core/Config/Options.hs new/hspec-core-2.8.4/src/Test/Hspec/Core/Config/Options.hs --- old/hspec-core-2.8.3/src/Test/Hspec/Core/Config/Options.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/src/Test/Hspec/Core/Config/Options.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,356 +1,92 @@ +{-# LANGUAGE CPP #-} module Test.Hspec.Core.Config.Options ( - Config(..) -, ColorMode (..) -, defaultConfig -, filterOr -, parseOptions -, ConfigFile -, ignoreConfigFile + ConfigFile , envVarName +, ignoreConfigFile +, parseOptions ) where import Prelude () import Test.Hspec.Core.Compat import System.Exit -import System.Console.GetOpt -import Test.Hspec.Core.Format (Format, FormatConfig) -import qualified Test.Hspec.Core.Formatters.V1 as V1 -import qualified Test.Hspec.Core.Formatters.V2 as V2 -import Test.Hspec.Core.Config.Util -import Test.Hspec.Core.Util -import Test.Hspec.Core.Example (Params(..), defaultParams) -import Data.Functor.Identity -import Data.Maybe +import Test.Hspec.Core.Config.Definition +import qualified GetOpt.Declarative as Declarative +import GetOpt.Declarative.Interpret (parse, interpretOptions, ParseResult(..)) type ConfigFile = (FilePath, [String]) - type EnvVar = [String] envVarName :: String envVarName = "HSPEC_OPTIONS" -data Config = Config { - configIgnoreConfigFile :: Bool -, configDryRun :: Bool -, configFocusedOnly :: Bool -, configFailOnFocused :: Bool -, configPrintSlowItems :: Maybe Int -, configPrintCpuTime :: Bool -, configFastFail :: Bool -, configRandomize :: Bool -, configFailureReport :: Maybe FilePath -, configRerun :: Bool -, configRerunAllOnSuccess :: Bool - --- | --- A predicate that is used to filter the spec before it is run. Only examples --- that satisfy the predicate are run. -, configFilterPredicate :: Maybe (Path -> Bool) -, configSkipPredicate :: Maybe (Path -> Bool) -, configQuickCheckSeed :: Maybe Integer -, configQuickCheckMaxSuccess :: Maybe Int -, configQuickCheckMaxDiscardRatio :: Maybe Int -, configQuickCheckMaxSize :: Maybe Int -, configQuickCheckMaxShrinks :: Maybe Int -, configSmallCheckDepth :: Int -, configColorMode :: ColorMode -, configDiff :: Bool -, configTimes :: Bool -, configFormat :: Maybe (FormatConfig -> IO Format) -, configFormatter :: Maybe V1.Formatter -- ^ deprecated, use `configFormat` instead -, configHtmlOutput :: Bool -, configConcurrentJobs :: Maybe Int -} - -defaultConfig :: Config -defaultConfig = Config { - configIgnoreConfigFile = False -, configDryRun = False -, configFocusedOnly = False -, configFailOnFocused = False -, configPrintSlowItems = Nothing -, configPrintCpuTime = False -, configFastFail = False -, configRandomize = False -, configFailureReport = Nothing -, configRerun = False -, configRerunAllOnSuccess = False -, configFilterPredicate = Nothing -, configSkipPredicate = Nothing -, configQuickCheckSeed = Nothing -, configQuickCheckMaxSuccess = Nothing -, configQuickCheckMaxDiscardRatio = Nothing -, configQuickCheckMaxSize = Nothing -, configQuickCheckMaxShrinks = Nothing -, configSmallCheckDepth = paramsSmallCheckDepth defaultParams -, configColorMode = ColorAuto -, configDiff = True -, configTimes = False -, configFormat = Nothing -, configFormatter = Nothing -, configHtmlOutput = False -, configConcurrentJobs = Nothing -} - -filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool) -filterOr p1_ p2_ = case (p1_, p2_) of - (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path - _ -> p1_ <|> p2_ - -addMatch :: String -> Config -> Config -addMatch s c = c {configFilterPredicate = Just (filterPredicate s) `filterOr` configFilterPredicate c} - -addSkip :: String -> Config -> Config -addSkip s c = c {configSkipPredicate = Just (filterPredicate s) `filterOr` configSkipPredicate c} - -setDepth :: Int -> Config -> Config -setDepth n c = c {configSmallCheckDepth = n} - -setMaxSuccess :: Int -> Config -> Config -setMaxSuccess n c = c {configQuickCheckMaxSuccess = Just n} - -setMaxDiscardRatio :: Int -> Config -> Config -setMaxDiscardRatio n c = c {configQuickCheckMaxDiscardRatio = Just n} - -setMaxSize :: Int -> Config -> Config -setMaxSize n c = c {configQuickCheckMaxSize = Just n} - -setMaxShrinks :: Int -> Config -> Config -setMaxShrinks n c = c {configQuickCheckMaxShrinks = Just n} - -setSeed :: Integer -> Config -> Config -setSeed n c = c {configQuickCheckSeed = Just n} - -data ColorMode = ColorAuto | ColorNever | ColorAlways - deriving (Eq, Show) - -type Result m = Either InvalidArgument (m Config) - -data InvalidArgument = InvalidArgument String String - -data Arg a = Arg { - _argumentName :: String -, _argumentParser :: String -> Maybe a -, _argumentSetter :: a -> Config -> Config -} - -mkOption :: Monad m => [Char] -> String -> Arg a -> String -> OptDescr (Result m -> Result m) -mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help - where - arg input x = x >>= \c -> case parser input of - Just n -> Right (setter n `liftM` c) - Nothing -> Left (InvalidArgument name input) - -printSlowItemsOption :: Monad m => OptDescr (Result m -> Result m) -printSlowItemsOption = Option "p" [name] (OptArg arg "N") "print the N slowest spec items (default: 10)" - where - name = "print-slow-items" - setter v c = c {configPrintSlowItems = v} - arg = maybe (set (setter $ Just 10)) parseArg - parseArg input x = x >>= \ c -> case readMaybe input of - Just 0 -> Right (setter Nothing `liftM` c) - Just n -> Right (setter (Just n) `liftM` c) - Nothing -> Left (InvalidArgument name input) - -mkFlag :: Monad m => String -> (Bool -> Config -> Config) -> String -> [OptDescr (Result m -> Result m)] -mkFlag name setter help = [ - Option [] [name] (NoArg $ set $ setter True) help - , Option [] ["no-" ++ name] (NoArg $ set $ setter False) ("do not " ++ help) - ] - -commandLineOptions :: [OptDescr (Result Maybe -> Result Maybe)] -commandLineOptions = [ - Option [] ["help"] (NoArg (const $ Right Nothing)) "display this help and exit" - , Option [] ["ignore-dot-hspec"] (NoArg setIgnoreConfigFile) "do not read options from ~/.hspec and .hspec" - , mkOption "m" "match" (Arg "PATTERN" return addMatch) "only run examples that match given PATTERN" - , mkOption [] "skip" (Arg "PATTERN" return addSkip) "skip examples that match given PATTERN" - ] - where - setIgnoreConfigFile = set $ \config -> config {configIgnoreConfigFile = True} - -formatterOptions :: Monad m => [OptDescr (Result m -> Result m)] -formatterOptions = concat [ - [mkOption "f" "format" (Arg "FORMATTER" readFormatter setFormatter) helpForFormat] - , mkFlag "color" setColor "colorize the output" - , mkFlag "diff" setDiff "show colorized diffs" - , mkFlag "times" setTimes "report times for individual spec items" - , [Option [] ["print-cpu-time"] (NoArg setPrintCpuTime) "include used CPU time in summary"] - , [printSlowItemsOption] - ] - where - formatters :: [(String, FormatConfig -> IO Format)] - formatters = map (fmap V2.formatterToFormat) [ - ("checks", V2.checks) - , ("specdoc", V2.specdoc) - , ("progress", V2.progress) - , ("failed-examples", V2.failed_examples) - , ("silent", V2.silent) - ] - - helpForFormat :: String - helpForFormat = "use a custom formatter; this can be one of " ++ (formatOrList $ map fst formatters) - - readFormatter :: String -> Maybe (FormatConfig -> IO Format) - readFormatter = (`lookup` formatters) - - setFormatter :: (FormatConfig -> IO Format) -> Config -> Config - setFormatter f c = c {configFormat = Just f} - - setColor :: Bool -> Config -> Config - setColor v config = config {configColorMode = if v then ColorAlways else ColorNever} - - setDiff :: Bool -> Config -> Config - setDiff v config = config {configDiff = v} - - setTimes :: Bool -> Config -> Config - setTimes v config = config {configTimes = v} - - setPrintCpuTime = set $ \config -> config {configPrintCpuTime = True} - -smallCheckOptions :: Monad m => [OptDescr (Result m -> Result m)] -smallCheckOptions = [ - mkOption [] "depth" (Arg "N" readMaybe setDepth) "maximum depth of generated test values for SmallCheck properties" - ] - -quickCheckOptions :: Monad m => [OptDescr (Result m -> Result m)] -quickCheckOptions = [ - mkOption "a" "qc-max-success" (Arg "N" readMaybe setMaxSuccess) "maximum number of successful tests before a QuickCheck property succeeds" - , mkOption "" "qc-max-discard" (Arg "N" readMaybe setMaxDiscardRatio) "maximum number of discarded tests per successful test before giving up" - , mkOption "" "qc-max-size" (Arg "N" readMaybe setMaxSize) "size to use for the biggest test cases" - , mkOption "" "qc-max-shrinks" (Arg "N" readMaybe setMaxShrinks) "maximum number of shrinks to perform before giving up (a value of 0 turns shrinking off)" - , mkOption [] "seed" (Arg "N" readMaybe setSeed) "used seed for QuickCheck properties" - ] - -runnerOptions :: Monad m => [OptDescr (Result m -> Result m)] -runnerOptions = concat [ - mkFlag "dry-run" setDryRun "pretend that everything passed; don't verify anything" - , mkFlag "focused-only" setFocusedOnly "do not run anything, unless there are focused spec items" - , mkFlag "fail-on-focused" setFailOnFocused "fail on focused spec items" - , mkFlag "fail-fast" setFastFail "abort on first failure" - , mkFlag "randomize" setRandomize "randomize execution order" - ] ++ [ - Option "r" ["rerun"] (NoArg setRerun) "rerun all examples that failed in the previous test run (only works in combination with --failure-report or in GHCi)" - , mkOption [] "failure-report" (Arg "FILE" return setFailureReport) "read/write a failure report for use with --rerun" - , Option [] ["rerun-all-on-success"] (NoArg setRerunAllOnSuccess) "run the whole test suite after a previously failing rerun succeeds for the first time (only works in combination with --rerun)" - - - , mkOption "j" "jobs" (Arg "N" readMaxJobs setMaxJobs) "run at most N parallelizable tests simultaneously (default: number of available processors)" - ] - where - readMaxJobs :: String -> Maybe Int - readMaxJobs s = do - n <- readMaybe s - guard $ n > 0 - return n - - setFailureReport :: String -> Config -> Config - setFailureReport file c = c {configFailureReport = Just file} - - setMaxJobs :: Int -> Config -> Config - setMaxJobs n c = c {configConcurrentJobs = Just n} - - setDryRun :: Bool -> Config -> Config - setDryRun value config = config {configDryRun = value} - - setFocusedOnly :: Bool -> Config -> Config - setFocusedOnly value config = config {configFocusedOnly = value} +commandLineOptions :: [(String, [Declarative.Option Config])] +commandLineOptions = + ("OPTIONS", commandLineOnlyOptions) + : otherOptions - setFailOnFocused :: Bool -> Config -> Config - setFailOnFocused value config = config {configFailOnFocused = value} - - setFastFail :: Bool -> Config -> Config - setFastFail value config = config {configFastFail = value} - - setRandomize :: Bool -> Config -> Config - setRandomize value config = config {configRandomize = value} - - setRerun = set $ \config -> config {configRerun = True} - setRerunAllOnSuccess = set $ \config -> config {configRerunAllOnSuccess = True} - -documentedConfigFileOptions :: Monad m => [(String, [OptDescr (Result m -> Result m)])] -documentedConfigFileOptions = [ +otherOptions :: [(String, [Declarative.Option Config])] +otherOptions = [ ("RUNNER OPTIONS", runnerOptions) , ("FORMATTER OPTIONS", formatterOptions) , ("OPTIONS FOR QUICKCHECK", quickCheckOptions) , ("OPTIONS FOR SMALLCHECK", smallCheckOptions) ] -documentedOptions :: [(String, [OptDescr (Result Maybe -> Result Maybe)])] -documentedOptions = ("OPTIONS", commandLineOptions) : documentedConfigFileOptions - -configFileOptions :: Monad m => [OptDescr (Result m -> Result m)] -configFileOptions = (concat . map snd) documentedConfigFileOptions - -set :: Monad m => (Config -> Config) -> Either a (m Config) -> Either a (m Config) -set = liftM . liftM - -undocumentedOptions :: Monad m => [OptDescr (Result m -> Result m)] -undocumentedOptions = [ - -- for compatibility with test-framework - mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default" - - -- undocumented for now, as we probably want to change this to produce a - -- standalone HTML report in the future - , Option [] ["html"] (NoArg setHtml) "produce HTML output" - ] - where - setHtml = set $ \config -> config {configHtmlOutput = True} - -recognizedOptions :: [OptDescr (Result Maybe -> Result Maybe)] -recognizedOptions = commandLineOptions ++ configFileOptions ++ undocumentedOptions +ignoreConfigFile :: Config -> [String] -> IO Bool +ignoreConfigFile config args = do + ignore <- lookupEnv "IGNORE_DOT_HSPEC" + case ignore of + Just _ -> return True + Nothing -> case parseCommandLineOptions "" args config of + Right c -> return (configIgnoreConfigFile c) + _ -> return False -parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [String] -> Either (ExitCode, String) Config -parseOptions config prog configFiles envVar args = do +parseOptions :: Config -> String -> [ConfigFile] -> Maybe EnvVar -> [(String, String)] -> [String] -> Either (ExitCode, String) ([String], Config) +parseOptions config prog configFiles envVar env args = do foldM (parseFileOptions prog) config configFiles - >>= parseEnvVarOptions prog envVar - >>= parseCommandLineOptions prog args + >>= maybe return (parseEnvVarOptions prog) envVar + >>= parseEnvironmentOptions env + >>= traverseTuple (parseCommandLineOptions prog args) + +traverseTuple :: Applicative f => (a -> f b) -> (c, a) -> f (c, b) +#if MIN_VERSION_base(4,7,0) +traverseTuple = traverse +#else +traverseTuple f (c, a) = (,) c <$> f a +#endif parseCommandLineOptions :: String -> [String] -> Config -> Either (ExitCode, String) Config -parseCommandLineOptions prog args config = case parse recognizedOptions config args of - Right Nothing -> Left (ExitSuccess, usage) - Right (Just c) -> Right c - Left err -> failure err +parseCommandLineOptions prog args config = case Declarative.parseCommandLineOptions commandLineOptions prog args config of + Success c -> Right c + Help message -> Left (ExitSuccess, message) + Failure message -> Left (ExitFailure 1, message) + +parseEnvironmentOptions :: [(String, String)] -> Config -> Either (ExitCode, String) ([String], Config) +parseEnvironmentOptions env config = case Declarative.parseEnvironmentOptions "HSPEC" env config (concatMap snd commandLineOptions) of + (warnings, c) -> Right (map formatWarning warnings, c) where - failure err = Left (ExitFailure 1, prog ++ ": " ++ err ++ "\nTry `" ++ prog ++ " --help' for more information.\n") - - usage :: String - usage = "Usage: " ++ prog ++ " [OPTION]...\n\n" - ++ (intercalate "\n" $ map (uncurry mkUsageInfo) documentedOptions) + formatWarning (Declarative.InvalidValue name value) = "invalid value `" ++ value ++ "' for environment variable " ++ name parseFileOptions :: String -> Config -> ConfigFile -> Either (ExitCode, String) Config parseFileOptions prog config (name, args) = parseOtherOptions prog ("in config file " ++ name) args config -parseEnvVarOptions :: String -> (Maybe EnvVar) -> Config -> Either (ExitCode, String) Config -parseEnvVarOptions prog args = - parseOtherOptions prog ("from environment variable " ++ envVarName) (fromMaybe [] args) +parseEnvVarOptions :: String -> EnvVar -> Config -> Either (ExitCode, String) Config +parseEnvVarOptions prog = + parseOtherOptions prog ("from environment variable " ++ envVarName) parseOtherOptions :: String -> String -> [String] -> Config -> Either (ExitCode, String) Config -parseOtherOptions prog source args config = case parse configFileOptions config args of - Right (Identity c) -> Right c +parseOtherOptions prog source args config = case parse (interpretOptions options) config args of + Right c -> Right c Left err -> failure err where + options :: [Declarative.Option Config] + options = filter Declarative.optionDocumented $ concatMap snd otherOptions + failure err = Left (ExitFailure 1, prog ++ ": " ++ message) where message = unlines $ case lines err of [x] -> [x ++ " " ++ source] xs -> xs ++ [source] - -parse :: Monad m => [OptDescr (Result m -> Result m)] -> Config -> [String] -> Either String (m Config) -parse options config args = case getOpt Permute options args of - (opts, [], []) -> case foldl' (flip id) (Right $ return config) opts of - Left (InvalidArgument name value) -> Left ("invalid argument `" ++ value ++ "' for `--" ++ name ++ "'") - Right x -> Right x - (_, _, err:_) -> Left (init err) - (_, arg:_, _) -> Left ("unexpected argument `" ++ arg ++ "'") - -ignoreConfigFile :: Config -> [String] -> IO Bool -ignoreConfigFile config args = do - ignore <- lookupEnv "IGNORE_DOT_HSPEC" - case ignore of - Just _ -> return True - Nothing -> case parse recognizedOptions config args of - Right (Just c) -> return (configIgnoreConfigFile c) - _ -> return False diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/Test/Hspec/Core/Config/Util.hs new/hspec-core-2.8.4/src/Test/Hspec/Core/Config/Util.hs --- old/hspec-core-2.8.3/src/Test/Hspec/Core/Config/Util.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/src/Test/Hspec/Core/Config/Util.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,40 +0,0 @@ -module Test.Hspec.Core.Config.Util where - -import Prelude () -import Test.Hspec.Core.Compat - -import System.Console.GetOpt - -import Test.Hspec.Core.Util - -modifyHelp :: (String -> String) -> OptDescr a -> OptDescr a -modifyHelp modify (Option s n a help) = Option s n a (modify help) - -mkUsageInfo :: String -> [OptDescr a] -> String -mkUsageInfo title = usageInfo title . addLineBreaksForHelp . condenseNoOptions - -addLineBreaksForHelp :: [OptDescr a] -> [OptDescr a] -addLineBreaksForHelp options = map (modifyHelp addLineBreaks) options - where - withoutHelpWidth = maxLength . usageInfo "" . map removeHelp - helpWidth = 80 - withoutHelpWidth options - - addLineBreaks = unlines . lineBreaksAt helpWidth - - maxLength = maximum . map length . lines - removeHelp = modifyHelp (const "") - -condenseNoOptions :: [OptDescr a] -> [OptDescr a] -condenseNoOptions options = case options of - Option "" [optionA] arg help : Option "" [optionB] _ _ : ys | optionB == ("no-" ++ optionA) -> - Option "" ["[no-]" ++ optionA] arg help : condenseNoOptions ys - x : xs -> x : condenseNoOptions xs - [] -> [] - -formatOrList :: [String] -> String -formatOrList xs = case xs of - [] -> "" - x : ys -> (case ys of - [] -> x - _ : [] -> x ++ " or " - _ : _ : _ -> x ++ ", ") ++ formatOrList ys diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/Test/Hspec/Core/Config.hs new/hspec-core-2.8.4/src/Test/Hspec/Core/Config.hs --- old/hspec-core-2.8.3/src/Test/Hspec/Core/Config.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/src/Test/Hspec/Core/Config.hs 2001-09-09 03:46:40.000000000 +0200 @@ -24,11 +24,12 @@ import System.Exit import System.FilePath import System.Directory -import System.Environment (getProgName) +import System.Environment (getProgName, getEnvironment) import qualified Test.QuickCheck as QC import Test.Hspec.Core.Util import Test.Hspec.Core.Config.Options +import Test.Hspec.Core.Config.Definition (Config(..), ColorMode(..), defaultConfig, filterOr) import Test.Hspec.Core.FailureReport import Test.Hspec.Core.QuickCheckUtil (mkGen) import Test.Hspec.Core.Example (Params(..), defaultParams) @@ -117,10 +118,13 @@ case ignore of True -> return [] False -> readConfigFiles - envVar <- fmap words <$> lookupEnv envVarName - case parseOptions opts_ prog configFiles envVar args of + env <- getEnvironment + let envVar = words <$> lookup envVarName env + case parseOptions opts_ prog configFiles envVar env args of Left (err, msg) -> exitWithMessage err msg - Right opts -> return opts + Right (warnings, opts) -> do + mapM_ (hPutStrLn stderr) warnings + return opts readFailureReportOnRerun :: Config -> IO (Maybe FailureReport) readFailureReportOnRerun config diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/Test/Hspec/Core/Example/Location.hs new/hspec-core-2.8.4/src/Test/Hspec/Core/Example/Location.hs --- old/hspec-core-2.8.3/src/Test/Hspec/Core/Example/Location.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/src/Test/Hspec/Core/Example/Location.hs 2001-09-09 03:46:40.000000000 +0200 @@ -76,7 +76,11 @@ fromPatternMatchFailureInDoExpression :: String -> Maybe Location fromPatternMatchFailureInDoExpression input = +#if MIN_VERSION_base(4,16,0) + stripPrefix "Pattern match failure in 'do' block at " input >>= parseSourceSpan +#else stripPrefix "Pattern match failure in do expression at " input >>= parseSourceSpan +#endif parseCallStack :: String -> Maybe Location parseCallStack input = case reverse (lines input) of diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/src/Test/Hspec/Core/FailureReport.hs new/hspec-core-2.8.4/src/Test/Hspec/Core/FailureReport.hs --- old/hspec-core-2.8.3/src/Test/Hspec/Core/FailureReport.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/src/Test/Hspec/Core/FailureReport.hs 2001-09-09 03:46:40.000000000 +0200 @@ -15,7 +15,7 @@ import System.IO import System.Directory import Test.Hspec.Core.Util (Path) -import Test.Hspec.Core.Config.Options (Config(..)) +import Test.Hspec.Core.Config.Definition (Config(..)) data FailureReport = FailureReport { failureReportSeed :: Integer diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/test/GetOpt/Declarative/EnvironmentSpec.hs new/hspec-core-2.8.4/test/GetOpt/Declarative/EnvironmentSpec.hs --- old/hspec-core-2.8.3/test/GetOpt/Declarative/EnvironmentSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/test/GetOpt/Declarative/EnvironmentSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,70 @@ +{-# OPTIONS_GHC -fno-warn-missing-fields #-} +module GetOpt.Declarative.EnvironmentSpec (spec) where + +import Prelude () +import Helper + +import GetOpt.Declarative.Types +import GetOpt.Declarative.Environment + +spec :: Spec +spec = do + describe "parseEnvironmentOption" $ do + context "with NoArg" $ do + let + option :: Option Bool + option = Option { + optionName = "some-flag" + , optionSetter = NoArg $ const True + } + it "accepts 'yes'" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "yes")] False option `shouldBe` Right True + + it "rejects other values" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "no")] False option `shouldBe` invalidValue "FOO_SOME_FLAG" "no" + + context "with Flag" $ do + let + option :: Option Bool + option = Option { + optionName = "some-flag" + , optionSetter = Flag $ \ value _ -> value + } + it "accepts 'yes'" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "yes")] False option `shouldBe` Right True + + it "accepts 'no'" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "no")] True option `shouldBe` Right False + + it "rejects other values" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "nay")] True option `shouldBe` invalidValue "FOO_SOME_FLAG" "nay" + + context "with OptArg" $ do + let + option :: Option String + option = Option { + optionName = "some-flag" + , optionSetter = OptArg undefined $ \ (Just arg) _ -> guard (arg == "yes") >> Just arg + } + + it "accepts valid values" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "yes")] "" option `shouldBe` Right "yes" + + it "rejects invalid values" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "no")] "" option `shouldBe` invalidValue "FOO_SOME_FLAG" "no" + + context "with Arg" $ do + let + option :: Option String + option = Option { + optionName = "some-flag" + , optionSetter = Arg undefined $ \ arg _ -> guard (arg == "yes") >> Just arg + } + + it "accepts valid values" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "yes")] "" option `shouldBe` Right "yes" + + it "rejects invalid values" $ do + parseEnvironmentOption "FOO" [("FOO_SOME_FLAG", "no")] "" option `shouldBe` invalidValue "FOO_SOME_FLAG" "no" + where + invalidValue name = Left . InvalidValue name diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/test/GetOpt/Declarative/UtilSpec.hs new/hspec-core-2.8.4/test/GetOpt/Declarative/UtilSpec.hs --- old/hspec-core-2.8.3/test/GetOpt/Declarative/UtilSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/test/GetOpt/Declarative/UtilSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,31 @@ +module GetOpt.Declarative.UtilSpec (spec) where + +import Prelude () +import Helper + +import System.Console.GetOpt + +import GetOpt.Declarative.Util + +spec :: Spec +spec = do + describe "mkUsageInfo" $ do + it "restricts output size to 80 characters" $ do + let options = [ + Option "" ["color"] (NoArg ()) (unwords $ replicate 3 "some very long and verbose help text") + ] + mkUsageInfo "" options `shouldBe` unlines [ + "" + , " --color some very long and verbose help text some very long and verbose" + , " help text some very long and verbose help text" + ] + + it "condenses help for --no-options" $ do + let options = [ + Option "" ["color"] (NoArg ()) "some help" + , Option "" ["no-color"] (NoArg ()) "some other help" + ] + mkUsageInfo "" options `shouldBe` unlines [ + "" + , " --[no-]color some help" + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/test/Test/Hspec/Core/Config/DefinitionSpec.hs new/hspec-core-2.8.4/test/Test/Hspec/Core/Config/DefinitionSpec.hs --- old/hspec-core-2.8.3/test/Test/Hspec/Core/Config/DefinitionSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/hspec-core-2.8.4/test/Test/Hspec/Core/Config/DefinitionSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -0,0 +1,12 @@ +module Test.Hspec.Core.Config.DefinitionSpec (spec) where + +import Prelude () +import Helper + +import Test.Hspec.Core.Config.Definition + +spec :: Spec +spec = do + describe "formatOrList" $ do + it "formats a list of or-options" $ do + formatOrList ["foo", "bar", "baz"] `shouldBe` "foo, bar or baz" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/test/Test/Hspec/Core/Config/OptionsSpec.hs new/hspec-core-2.8.4/test/Test/Hspec/Core/Config/OptionsSpec.hs --- old/hspec-core-2.8.3/test/Test/Hspec/Core/Config/OptionsSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/test/Test/Hspec/Core/Config/OptionsSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -17,97 +17,101 @@ spec = do describe "parseOptions" $ do - let parseOptions = Options.parseOptions defaultConfig "my-spec" + let parseOptions configFiles envVar env args = snd <$> Options.parseOptions defaultConfig "my-spec" configFiles envVar env args it "rejects unexpected arguments" $ do - fromLeft (parseOptions [] Nothing ["foo"]) `shouldBe` (ExitFailure 1, "my-spec: unexpected argument `foo'\nTry `my-spec --help' for more information.\n") + fromLeft (parseOptions [] Nothing [] ["foo"]) `shouldBe` (ExitFailure 1, "my-spec: unexpected argument `foo'\nTry `my-spec --help' for more information.\n") it "rejects unrecognized options" $ do - fromLeft (parseOptions [] Nothing ["--foo"]) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--foo'\nTry `my-spec --help' for more information.\n") + fromLeft (parseOptions [] Nothing [] ["--foo"]) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--foo'\nTry `my-spec --help' for more information.\n") it "sets configColorMode to ColorAuto" $ do - configColorMode <$> parseOptions [] Nothing [] `shouldBe` Right ColorAuto + configColorMode <$> parseOptions [] Nothing [] [] `shouldBe` Right ColorAuto + + context "when the same option is specified multiple times" $ do + it "gives later occurrences precedence" $ do + configColorMode <$> parseOptions [] Nothing [] ["--color", "--no-color"] `shouldBe` Right ColorNever context "with --help" $ do - let Left (code, output) = parseOptions [] Nothing ["--help"] - help = lines output + let Left (code, help) = Options.parseOptions defaultConfig "spec" [] Nothing [] ["--help"] it "returns ExitSuccess" $ do code `shouldBe` ExitSuccess it "prints help" $ do - help `shouldStartWith` ["Usage: my-spec [OPTION]..."] + expected <- readFile "help.txt" + help `shouldBe` expected context "with --color" $ do it "sets configColorMode to ColorAlways" $ do - configColorMode <$> parseOptions [] Nothing ["--color"] `shouldBe` Right ColorAlways + configColorMode <$> parseOptions [] Nothing [] ["--color"] `shouldBe` Right ColorAlways context "with --no-color" $ do it "sets configColorMode to ColorNever" $ do - configColorMode <$> parseOptions [] Nothing ["--no-color"] `shouldBe` Right ColorNever + configColorMode <$> parseOptions [] Nothing [] ["--no-color"] `shouldBe` Right ColorNever context "with --diff" $ do it "sets configDiff to True" $ do - configDiff <$> parseOptions [] Nothing ["--diff"] `shouldBe` Right True + configDiff <$> parseOptions [] Nothing [] ["--diff"] `shouldBe` Right True context "with --no-diff" $ do it "sets configDiff to False" $ do - configDiff <$> parseOptions [] Nothing ["--no-diff"] `shouldBe` Right False + configDiff <$> parseOptions [] Nothing [] ["--no-diff"] `shouldBe` Right False context "with --print-slow-items" $ do it "sets configPrintSlowItems to N" $ do - configPrintSlowItems <$> parseOptions [] Nothing ["--print-slow-items=5"] `shouldBe` Right (Just 5) + configPrintSlowItems <$> parseOptions [] Nothing [] ["--print-slow-items=5"] `shouldBe` Right (Just 5) it "defaults N to 10" $ do - configPrintSlowItems <$> parseOptions [] Nothing ["--print-slow-items"] `shouldBe` Right (Just 10) + configPrintSlowItems <$> parseOptions [] Nothing [] ["--print-slow-items"] `shouldBe` Right (Just 10) it "rejects invalid values" $ do let msg = "my-spec: invalid argument `foo' for `--print-slow-items'\nTry `my-spec --help' for more information.\n" - void (parseOptions [] Nothing ["--print-slow-items=foo"]) `shouldBe` Left (ExitFailure 1, msg) + void (parseOptions [] Nothing [] ["--print-slow-items=foo"]) `shouldBe` Left (ExitFailure 1, msg) context "when N is 0" $ do it "disables the option" $ do - configPrintSlowItems <$> parseOptions [] Nothing ["-p0"] `shouldBe` Right Nothing + configPrintSlowItems <$> parseOptions [] Nothing [] ["-p0"] `shouldBe` Right Nothing context "with --qc-max-success" $ do it "sets QuickCheck maxSuccess" $ do - maxSuccess . configQuickCheckArgs <$> (parseOptions [] Nothing ["--qc-max-success", "23"]) `shouldBe` Right 23 + maxSuccess . configQuickCheckArgs <$> (parseOptions [] Nothing [] ["--qc-max-success", "23"]) `shouldBe` Right 23 context "when given an invalid argument" $ do it "returns an error message" $ do - fromLeft (parseOptions [] Nothing ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n") + fromLeft (parseOptions [] Nothing [] ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n") context "with --qc-max-shrinks" $ do it "sets QuickCheck maxShrinks" $ do - maxShrinks . configQuickCheckArgs <$> (parseOptions [] Nothing ["--qc-max-shrinks", "23"]) `shouldBe` Right 23 + maxShrinks . configQuickCheckArgs <$> (parseOptions [] Nothing [] ["--qc-max-shrinks", "23"]) `shouldBe` Right 23 context "with --depth" $ do it "sets depth parameter for SmallCheck" $ do - configSmallCheckDepth <$> parseOptions [] Nothing ["--depth", "23"] `shouldBe` Right 23 + configSmallCheckDepth <$> parseOptions [] Nothing [] ["--depth", "23"] `shouldBe` Right 23 context "with --jobs" $ do it "sets number of concurrent jobs" $ do - configConcurrentJobs <$> parseOptions [] Nothing ["--jobs=23"] `shouldBe` Right (Just 23) + configConcurrentJobs <$> parseOptions [] Nothing [] ["--jobs=23"] `shouldBe` Right (Just 23) it "rejects values < 1" $ do let msg = "my-spec: invalid argument `0' for `--jobs'\nTry `my-spec --help' for more information.\n" - void (parseOptions [] Nothing ["--jobs=0"]) `shouldBe` Left (ExitFailure 1, msg) + void (parseOptions [] Nothing [] ["--jobs=0"]) `shouldBe` Left (ExitFailure 1, msg) context "when given a config file" $ do it "uses options from config file" $ do - configColorMode <$> parseOptions [("~/.hspec", ["--no-color"])] Nothing [] `shouldBe` Right ColorNever + configColorMode <$> parseOptions [("~/.hspec", ["--no-color"])] Nothing [] [] `shouldBe` Right ColorNever it "gives command-line options precedence" $ do - configColorMode <$> parseOptions [("~/.hspec", ["--no-color"])] Nothing ["--color"] `shouldBe` Right ColorAlways + configColorMode <$> parseOptions [("~/.hspec", ["--no-color"])] Nothing [] ["--color"] `shouldBe` Right ColorAlways it "rejects --help" $ do - fromLeft (parseOptions [("~/.hspec", ["--help"])] Nothing []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--help' in config file ~/.hspec\n") + fromLeft (parseOptions [("~/.hspec", ["--help"])] Nothing [] []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--help' in config file ~/.hspec\n") it "rejects unrecognized options" $ do - fromLeft (parseOptions [("~/.hspec", ["--invalid"])] Nothing []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' in config file ~/.hspec\n") + fromLeft (parseOptions [("~/.hspec", ["--invalid"])] Nothing [] []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' in config file ~/.hspec\n") it "rejects ambiguous options" $ do - fromLeft (parseOptions [("~/.hspec", ["--fail"])] Nothing []) `shouldBe` (ExitFailure 1, + fromLeft (parseOptions [("~/.hspec", ["--fail"])] Nothing [] []) `shouldBe` (ExitFailure 1, unlines [ "my-spec: option `--fail' is ambiguous; could be one of:" , " --fail-on-focused fail on focused spec items" @@ -117,19 +121,33 @@ ] ) + context "when the same option is specified multiple times" $ do + it "gives later occurrences precedence" $ do + configColorMode <$> parseOptions [("~/.hspec", ["--color", "--no-color"])] Nothing [] [] `shouldBe` Right ColorNever + context "when given multiple config files" $ do it "gives later config files precedence" $ do - configColorMode <$> parseOptions [("~/.hspec", ["--no-color"]), (".hspec", ["--color"])] Nothing [] `shouldBe` Right ColorAlways + configColorMode <$> parseOptions [("~/.hspec", ["--no-color"]), (".hspec", ["--color"])] Nothing [] [] `shouldBe` Right ColorAlways - context "when given an environment variable" $ do - it "uses options from environment variable" $ do - configColorMode <$> parseOptions [] (Just ["--no-color"]) [] `shouldBe` Right ColorNever + context "when given HSPEC_OPTIONS (deprecated)" $ do + it "uses options from HSPEC_OPTIONS" $ do + configColorMode <$> parseOptions [] (Just ["--no-color"]) [] [] `shouldBe` Right ColorNever it "gives command-line options precedence" $ do - configColorMode <$> parseOptions [] (Just ["--no-color"]) ["--color"] `shouldBe` Right ColorAlways + configColorMode <$> parseOptions [] (Just ["--no-color"]) [] ["--color"] `shouldBe` Right ColorAlways it "rejects unrecognized options" $ do - fromLeft (parseOptions [] (Just ["--invalid"]) []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' from environment variable HSPEC_OPTIONS\n") + fromLeft (parseOptions [] (Just ["--invalid"]) [] []) `shouldBe` (ExitFailure 1, "my-spec: unrecognized option `--invalid' from environment variable HSPEC_OPTIONS\n") + + context "when given an option as an environment variable" $ do + it "sets config value from environment variable" $ do + configColorMode <$> parseOptions [] Nothing [("HSPEC_COLOR", "no")] [] `shouldBe` Right ColorNever + + it "gives command-line options precedence" $ do + configColorMode <$> parseOptions [] Nothing [("HSPEC_COLOR", "no")] ["--color"] `shouldBe` Right ColorAlways + + it "warns on unrecognized option values" $ do + fmap configColorMode <$> Options.parseOptions defaultConfig "my-spec" [] Nothing [("HSPEC_COLOR", "foo")] [] `shouldBe` Right (["invalid value `foo' for environment variable HSPEC_COLOR"], ColorAuto) describe "ignoreConfigFile" $ around_ (withEnvironment []) $ do context "by default" $ do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/test/Test/Hspec/Core/Config/UtilSpec.hs new/hspec-core-2.8.4/test/Test/Hspec/Core/Config/UtilSpec.hs --- old/hspec-core-2.8.3/test/Test/Hspec/Core/Config/UtilSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/test/Test/Hspec/Core/Config/UtilSpec.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,35 +0,0 @@ -module Test.Hspec.Core.Config.UtilSpec (spec) where - -import Prelude () -import Helper - -import System.Console.GetOpt - -import Test.Hspec.Core.Config.Util - -spec :: Spec -spec = do - describe "mkUsageInfo" $ do - it "restricts output size to 80 characters" $ do - let options = [ - Option "" ["color"] (NoArg ()) (unwords $ replicate 3 "some very long and verbose help text") - ] - mkUsageInfo "" options `shouldBe` unlines [ - "" - , " --color some very long and verbose help text some very long and verbose" - , " help text some very long and verbose help text" - ] - - it "condenses help for --no-options" $ do - let options = [ - Option "" ["color"] (NoArg ()) "some help" - , Option "" ["no-color"] (NoArg ()) "some other help" - ] - mkUsageInfo "" options `shouldBe` unlines [ - "" - , " --[no-]color some help" - ] - - describe "formatOrList" $ do - it "formats a list of or-options" $ do - formatOrList ["foo", "bar", "baz"] `shouldBe` "foo, bar or baz" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/test/Test/Hspec/Core/ConfigSpec.hs new/hspec-core-2.8.4/test/Test/Hspec/Core/ConfigSpec.hs --- old/hspec-core-2.8.3/test/Test/Hspec/Core/ConfigSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/test/Test/Hspec/Core/ConfigSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,8 +9,17 @@ import Test.Hspec.Core.Config spec :: Spec -spec = do - describe "readConfigFiles" $ around_ inTempDirectory $ around_ (withEnvironment [("HOME", "/foo")]) $ do +spec = around_ inTempDirectory $ around_ (withEnvironment [("HOME", "foo")]) $ do + describe "readConfig" $ do + it "recognizes options from HSPEC_OPTIONS" $ do + withEnvironment [("HSPEC_OPTIONS", "--color")] $ do + configColorMode <$> readConfig defaultConfig [] `shouldReturn` ColorAlways + + it "recognizes options from HSPEC_*" $ do + withEnvironment [("HSPEC_COLOR", "yes")] $ do + configColorMode <$> readConfig defaultConfig [] `shouldReturn` ColorAlways + + describe "readConfigFiles" $ do it "reads .hspec" $ do dir <- getCurrentDirectory let name = dir </> ".hspec" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/vendor/Data/Algorithm/Diff.hs new/hspec-core-2.8.4/vendor/Data/Algorithm/Diff.hs --- old/hspec-core-2.8.3/vendor/Data/Algorithm/Diff.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/vendor/Data/Algorithm/Diff.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveFunctor #-} +{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Algorithm.Diff diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.8.3/version.yaml new/hspec-core-2.8.4/version.yaml --- old/hspec-core-2.8.3/version.yaml 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-core-2.8.4/version.yaml 2001-09-09 03:46:40.000000000 +0200 @@ -1 +1 @@ -&version 2.8.3 +&version 2.8.4
