HTF 0.6.0.1 → 0.7.0.0

raw patch · 3 files changed

+20/−16 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• HTF.cabal +2/−2
• Test/Framework/HaskellParser.hs +10/−10
• Test/Framework/TestManager.hs +8/−4

@@ -1,5 +1,5 @@ Name:             HTF-Version:          0.6.0.1+Version:          0.7.0.0 License:          LGPL License-File:     LICENSE Copyright:        (c) 2005-2010 Stefan Wehr@@ -24,7 +24,7 @@     The documentation of the "Test.Framework.Tutorial" module     provides a tutorial for the HTF. -Tested-With:      GHC==6.10.4, GHC==6.12+Tested-With:      GHC==6.10.4, GHC==6.12, GHC==7.0 Build-Type:       Simple Cabal-Version:    >= 1.6 Extra-Source-Files:

@@ -22,6 +22,7 @@ import Control.Exception ( evaluate, catch, SomeException ) import Prelude hiding ( catch ) +import qualified Language.Haskell.Exts as Exts import qualified Language.Haskell.Exts.Parser as Parser import qualified Language.Haskell.Exts.Syntax as Syn import qualified Language.Haskell.Exts.Extension as Ext@@ -46,7 +47,7 @@  parse :: FilePath -> String -> IO (ParseResult Module) parse originalFileName input =-    do r <- (evaluate $ Parser.parseModuleWithMode parseMode fixedInput)+    do r <- (evaluate $ Exts.parseFileContentsWithMode parseMode fixedInput)             `catch` (\(e::SomeException) ->                          return $ Parser.ParseFailed unknownLoc (show e))        case r of@@ -67,15 +68,14 @@          all operators are considered to be any sequence          of the symbols _:"'>!#$%&*+./<=>?@\^|-~ with at most length 8 -}       parseMode :: Parser.ParseMode-      parseMode = Parser.defaultParseMode { Parser.parseFilename =-                                              originalFileName-                                          , Parser.extensions =-                                              Ext.glasgowExts ++-                                              [Ext.ExplicitForall, Ext.BangPatterns]-                                          , Parser.fixities =-                                              Fix.baseFixities ++-                                              Fix.infixr_ 0 ["==>"]-                                          }+      parseMode = Parser.ParseMode { Parser.parseFilename = originalFileName+                                   , Parser.ignoreLanguagePragmas = False+                                   , Parser.ignoreLinePragmas = False+                                   , Parser.extensions = Ext.glasgowExts+                                   , Parser.fixities =+                                       Fix.baseFixities +++                                       Fix.infixr_ 0 ["==>"]+                                   }       unknownLoc :: Syn.SrcLoc       unknownLoc = Syn.SrcLoc originalFileName 0 0       transformModule (Syn.Module _ (Syn.ModuleName moduleName) _ _ _

@@ -34,6 +34,7 @@  import Control.Monad import Control.Monad.State+import System.Exit (ExitCode(..)) import Data.List ( isInfixOf ) import Text.PrettyPrint @@ -187,17 +188,17 @@ runFlatTests :: [FlatTest] -> TR () runFlatTests = mapM_ runFlatTest -runTest :: TestableHTF t => t -> IO ()+runTest :: TestableHTF t => t -> IO ExitCode runTest = runTestWithFilter (\_ -> True) -runTestWithArgs :: TestableHTF t => [String] -> t -> IO ()+runTestWithArgs :: TestableHTF t => [String] -> t -> IO ExitCode runTestWithArgs [] = runTest runTestWithArgs l = runTestWithFilter pred     where pred (FlatTest _ id _ _) = any (\s -> s `isInfixOf` id) l  type Filter = FlatTest -> Bool -runTestWithFilter :: TestableHTF t => Filter -> t -> IO ()+runTestWithFilter :: TestableHTF t => Filter -> t -> IO ExitCode runTestWithFilter pred t =     do s <- execStateT (runFlatTests (filter pred (flatten t)))                        initTestState@@ -215,7 +216,10 @@        when (error > 0) $           reportDoc (text "\nFailures:" $$ renderTestNames                                              (reverse (ts_error s)))-       return ()+       return $ case () of+                  _| failed == 0 && error == 0 -> ExitSuccess+                   | error == 0                -> ExitFailure 1+                   | otherwise                 -> ExitFailure 2     where       renderTestNames l =           nest 2 (vcat (map (\name -> text "*" <+> text name) l))