HTF 0.13.0.0 → 0.13.1.0
raw patch · 6 files changed
+16/−210 lines, 6 filesdep ~HUnitPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: HUnit
API changes (from Hackage documentation)
+ Test.Framework: runTest :: TestableHTF t => t -> IO ExitCode
Files
- ChangeLog +6/−0
- HTF.cabal +6/−4
- Test/Framework.hs +1/−1
- Test/Framework/HaskellParser.hs +0/−202
- Test/Framework/Preprocessor.hs +1/−1
- sample/sample-HTF.cabal +2/−2
ChangeLog view
@@ -1,3 +1,9 @@+* 0.13.1.0 (2015-08-21)+ - resolved compile error with HUnit == 1.3.0.0++* 0.13.0.0 (2015-08-21)+ - use cpphs for lexing (fixes many bugs related to lexing)+ * 0.12.2.4 (2015-03-22) - fixed bug that caused double quoted strings to appear in the output of error messages produced by assertEqual and co.
HTF.cabal view
@@ -1,8 +1,8 @@ Name: HTF-Version: 0.13.0.0+Version: 0.13.1.0 License: LGPL License-File: LICENSE-Copyright: (c) 2005-2014 Stefan Wehr+Copyright: (c) 2005-2015 Stefan Wehr Author: Stefan Wehr <wehr@factisresearch.com> Maintainer: Stefan Wehr <wehr@factisresearch.com> Stability: Beta@@ -141,10 +141,12 @@ mtl >= 1.1, old-time >= 1.0, random >= 1.0,- text+ text,+ HTF Other-Modules:+ Paths_HTF+ Test.Framework.Location Test.Framework.Preprocessor- Test.Framework.HaskellParser Default-language: Haskell2010 Library
Test/Framework.hs view
@@ -37,7 +37,7 @@ module Test.Framework.AssertM, -- * Organizing tests- TM.makeTestSuite, TM.TestSuite, TM.htfMain, TM.htfMainWithArgs, Loc.makeLoc+ TM.makeTestSuite, TM.TestSuite, TM.htfMain, TM.htfMainWithArgs, Loc.makeLoc, TM.runTest ) where
− Test/Framework/HaskellParser.hs
@@ -1,202 +0,0 @@-{-# LANGUAGE ScopedTypeVariables,CPP #-}---- This library is free software; you can redistribute it and/or--- modify it under the terms of the GNU Lesser General Public--- License as published by the Free Software Foundation; either--- version 2.1 of the License, or (at your option) any later version.------ This library is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU--- Lesser General Public License for more details.------ You should have received a copy of the GNU Lesser General Public--- License along with this library; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA-----module Test.Framework.HaskellParser where--import Data.Maybe-import Data.Char ( isSpace, isDigit )-import qualified Data.List as List-import Control.Exception ( evaluate, catch, SomeException )-#if !MIN_VERSION_base(4,6,0)-import Prelude hiding ( catch )-#endif--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-import qualified Language.Haskell.Exts.Fixity as Fix-import qualified Language.Haskell.Exts.SrcLoc as Src--import Test.Framework.Location-import Test.Framework.Utils--type Name = String--data Decl = Decl { decl_loc :: Location- , decl_name :: Name }- deriving (Show)--data Pragma = Pragma { pr_name :: String- , pr_args :: String- , pr_loc :: Location }- deriving (Show)--data ParseResult a = ParseOK a | ParseError Location String--data Module = Module { mod_name :: Name- , mod_imports :: [ImportDecl]- , mod_decls :: [Decl]- , mod_htfPragmas :: [Pragma] }- deriving (Show)--data ImportDecl = ImportDecl { imp_moduleName :: Name- , imp_qualified :: Bool- , imp_alias :: Maybe Name- , imp_loc :: Location }- deriving (Show)---- Returns for lines of the form '# <number> "<filename>"'--- (see http://gcc.gnu.org/onlinedocs/cpp/Preprocessor-Output.html#Preprocessor-Output)--- the value 'Just <number> "<filename>"'-parseCppLineInfoOut :: String -> Maybe (String, String)-parseCppLineInfoOut line =- case line of- '#':' ':c:rest- | isDigit c ->- case List.span isDigit rest of- (restDigits, ' ' : '"' : rest) ->- case dropWhile (/= '"') (reverse rest) of- '"' : fileNameRev ->- let line = (c:restDigits)- file = "\"" ++ reverse fileNameRev ++ "\""- in Just (line, file)- _ -> Nothing- _ -> Nothing- _ -> Nothing--parse :: FilePath -> String -> IO (ParseResult Module)-parse originalFileName input =- do r <- (evaluate $ Exts.parseFileContentsWithComments parseMode fixedInput)- `catch` (\(e::SomeException) ->- return $ Parser.ParseFailed unknownLoc (show e))- case r of- Parser.ParseFailed loc err -> return (ParseError (transformLoc loc) err)- Parser.ParseOk (m, comments) -> return $ ParseOK (transformModule m comments)- where- -- fixedInput serves two purposes:- -- 1. add a trailing \n- -- 2. turn lines of the form '# <number> "<filename>"' into GHC line pragmas '{-# LINE <number> <filename> #-}'- -- 2. turn lines of the form '#line <number> "<filename>"' into GHC line pragmas '{-# LINE <number> <filename> #-}'- -- 3. comment out lines starting with #- fixedInput :: String- fixedInput = (unlines . map fixLine . lines) input- where- fixLine s =- case parseCppLineInfoOut s of- Just (line, file) -> "{-# LINE " ++ line ++ " " ++ file ++ " #-}"- Nothing ->- case dropWhile isSpace s of- '#':'l':'i':'n':'e':rest -> "{-# LINE " ++ rest ++ " #-}"- '#':_ -> "-- " ++ s- _ -> s- {- FIXME: fixities needed for all operators. Heuristic:- all operators are considered to be any sequence- of the symbols _:"'>!#$%&*+./<=>?@\^|-~ with at most length 8 -}- parseMode :: Parser.ParseMode- parseMode = Parser.ParseMode { Parser.parseFilename = originalFileName- , Parser.baseLanguage = Ext.Haskell2010- , Parser.ignoreLanguagePragmas = False- , Parser.ignoreLinePragmas = False- , Parser.extensions = (map Ext.EnableExtension- extensions)- , Parser.fixities = Nothing- }- extensions =- [ Ext.ForeignFunctionInterface- , Ext.UnliftedFFITypes- , Ext.GADTs- , Ext.ScopedTypeVariables- , Ext.UnboxedTuples- , Ext.TypeSynonymInstances- , Ext.StandaloneDeriving- , Ext.DeriveDataTypeable- , Ext.FlexibleContexts- , Ext.FlexibleInstances- , Ext.ConstrainedClassMethods- , Ext.MultiParamTypeClasses- , Ext.FunctionalDependencies- , Ext.MagicHash- , Ext.PolymorphicComponents- , Ext.ExistentialQuantification- , Ext.UnicodeSyntax- , Ext.PostfixOperators- , Ext.PatternGuards- , Ext.LiberalTypeSynonyms- , Ext.RankNTypes- , Ext.ImpredicativeTypes- , Ext.TypeOperators- , Ext.RecursiveDo- , Ext.ParallelListComp- , Ext.EmptyDataDecls- , Ext.KindSignatures- , Ext.GeneralizedNewtypeDeriving- , Ext.TypeFamilies- , Ext.NamedFieldPuns- , Ext.RecordWildCards- , Ext.PackageImports- , Ext.ViewPatterns- , Ext.TupleSections- , Ext.NondecreasingIndentation- , Ext.DoAndIfThenElse- ]- unknownLoc :: Syn.SrcLoc- unknownLoc = Syn.SrcLoc originalFileName 0 0- transformModule (Syn.Module _ (Syn.ModuleName moduleName) _ _ _ imports decls)- comments =- Module moduleName (map transformImport imports)- (mapMaybe transformDecl decls)- (mapMaybe transformComment comments)-#if MIN_VERSION_haskell_src_exts(1,16,0) - transformImport (Syn.ImportDecl loc (Syn.ModuleName s)- qualified _ _ _ alias _) =- let alias' = case alias of- Nothing -> Nothing- Just (Syn.ModuleName s) -> Just s- in ImportDecl s qualified alias' (transformLoc loc)- transformDecl (Syn.PatBind loc (Syn.PVar name) _ _) =- Just $ Decl (transformLoc loc) (transformName name)-#else- transformImport (Syn.ImportDecl loc (Syn.ModuleName s)- qualified _ _ alias _) =- let alias' = case alias of- Nothing -> Nothing- Just (Syn.ModuleName s) -> Just s- in ImportDecl s qualified alias' (transformLoc loc)- transformDecl (Syn.PatBind loc (Syn.PVar name) _ _ _) =- Just $ Decl (transformLoc loc) (transformName name)-#endif- transformDecl (Syn.FunBind (Syn.Match loc name _ _ _ _ : _)) =- Just $ Decl (transformLoc loc) (transformName name)- transformDecl _ = Nothing- transformSpan span = makeLoc (Src.srcSpanFilename span) (Src.srcSpanStartLine span)- transformLoc (Syn.SrcLoc f n _) = makeLoc f n- transformName :: Syn.Name -> String- transformName (Syn.Ident s) = s- transformName (Syn.Symbol s) = s- transformComment (Exts.Comment True span ('@':s)) =- case reverse s of- '@':r ->- let stripped = strip (reverse r)- in if "HTF_" `List.isPrefixOf` stripped- then let (name, args) = List.span (not . isSpace) stripped- argsStripped = dropWhile isSpace args- loc = transformSpan span- in Just $ Pragma name argsStripped loc- else Nothing- _ -> Nothing- transformComment _ = Nothing
Test/Framework/Preprocessor.hs view
@@ -43,7 +43,7 @@ tokenise ) import System.IO ( hPutStrLn, stderr )-import Test.HUnit hiding (State)+import Test.HUnit hiding (State, Location) import Control.Monad.State.Strict import qualified Data.List as List import Data.Maybe
sample/sample-HTF.cabal view
@@ -13,12 +13,12 @@ executable sample main-is: Main.hs other-modules: MyPkg.A MyPkg.B- build-depends: base, HTF == 0.12.*+ build-depends: base, HTF == 0.13.* default-language: Haskell2010 test-suite sample-tests type: exitcode-stdio-1.0 main-is: TestMain.hs other-modules: MyPkg.A MyPkg.B- build-depends: base, HTF == 0.12.*+ build-depends: base, HTF == 0.13.* default-language: Haskell2010