diff --git a/ChangeLog b/ChangeLog --- a/ChangeLog +++ b/ChangeLog @@ -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. diff --git a/HTF.cabal b/HTF.cabal --- a/HTF.cabal +++ b/HTF.cabal @@ -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 Maintainer: Stefan Wehr 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 diff --git a/Test/Framework.hs b/Test/Framework.hs --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -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 diff --git a/Test/Framework/HaskellParser.hs b/Test/Framework/HaskellParser.hs deleted file mode 100644 --- a/Test/Framework/HaskellParser.hs +++ /dev/null @@ -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 '# ""' --- (see http://gcc.gnu.org/onlinedocs/cpp/Preprocessor-Output.html#Preprocessor-Output) --- the value 'Just ""' -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 '# ""' into GHC line pragmas '{-# LINE #-}' - -- 2. turn lines of the form '#line ""' into GHC line pragmas '{-# LINE #-}' - -- 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 diff --git a/Test/Framework/Preprocessor.hs b/Test/Framework/Preprocessor.hs --- a/Test/Framework/Preprocessor.hs +++ b/Test/Framework/Preprocessor.hs @@ -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 diff --git a/sample/sample-HTF.cabal b/sample/sample-HTF.cabal --- a/sample/sample-HTF.cabal +++ b/sample/sample-HTF.cabal @@ -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