tasty-kat-0.0.3/0000755000000000000000000000000012457516336011635 5ustar0000000000000000tasty-kat-0.0.3/LICENSE0000644000000000000000000000206712457516336012647 0ustar0000000000000000Copyright (c) 2015 Vincent Hanquez Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. tasty-kat-0.0.3/README.md0000644000000000000000000000366612457516336013127 0ustar0000000000000000tasty-kat ========= [![Build Status](https://travis-ci.org/vincenthz/tasty-kat.png?branch=master)](https://travis-ci.org/vincenthz/tasty-kat) [![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses) [![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) [Tasty-kat](http://hackage.haskell.org/package/tasty-kat) provides support for KAT (Known Answer Tests) testing. KAT files provides input and output tests for some functions for example, for testing the following function: r == a + b A KAT file could be: ```ini [2 digits addition] a = 10 b = 20 r = 30 a = 11 b = 21 r = 32 ``` This is somewhat similar to the [tasty-golden](http://hackage.haskell.org/package/tasty-golden) package, but instead of generating files and comparing output file to a golden file, tasty-kat loads input and output in test vectors and run specific function on it. Documentation: [tasty-kat on hackage](http://hackage.haskell.org/package/tasty-kat) ```haskell import Test.Tasty import Test.Tasty.KAT main = do kat <- testKatLoad "path/to/KAT" katLoaderSimple defaultMain [ testKatDetailed "kat-name" kat testKat ] where testAddition group kvs = case sequence $ map (flip lookup kvs) ["a","b","r"] of Nothing -> error "invalid vector" Just [a,b,r] -> let a = read as :: Int b = read bs :: Int r = read rs :: Int in return (a + b == r) ``` The detail output with 'testKatDetailed' looks like: ```shell add 1: OK 2: OK sub 1: OK add 1: OK base64 1: OK 2: OK ``` The grouped output with 'testKatGrouped' looks like: ```shell add: OK 2 tests succeed sub: OK 1 tests succeed add: OK 1 tests succeed base64: OK 2 tests succeed ``` tasty-kat-0.0.3/Setup.hs0000644000000000000000000000005612457516336013272 0ustar0000000000000000import Distribution.Simple main = defaultMain tasty-kat-0.0.3/tasty-kat.cabal0000644000000000000000000000305312457516336014543 0ustar0000000000000000Name: tasty-kat Version: 0.0.3 Synopsis: Known Answer Tests (KAT) framework for tasty Description: Tests running from simple KATs file (different formats/helper supported) License: MIT License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: vincent@snarc.org Category: tasty-kat Stability: experimental Build-Type: Simple Homepage: https://github.com/vincenthz/tasty-kat Bug-Reports: https://github.com/vincenthz/tasty-kat/issues Cabal-Version: >=1.10 extra-source-files: README.md , tests/KAT source-repository head type: git location: https://github.com/vincenthz/tasty-kat Library Exposed-modules: Test.Tasty.KAT , Test.Tasty.KAT.FileLoader Other-modules: Test.Tasty.KAT.Internal Build-depends: base >= 4 && < 5 , bytestring , tasty ghc-options: -Wall -fwarn-tabs default-language: Haskell2010 Test-Suite test-tasty-kat type: exitcode-stdio-1.0 hs-source-dirs: tests Main-is: Tests.hs Build-Depends: base >= 3 && < 5 , bytestring , mtl , tasty , tasty-quickcheck , tasty-hunit , tasty-kat ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures default-language: Haskell2010 tasty-kat-0.0.3/Test/0000755000000000000000000000000012457516336012554 5ustar0000000000000000tasty-kat-0.0.3/Test/Tasty/0000755000000000000000000000000012457516336013660 5ustar0000000000000000tasty-kat-0.0.3/Test/Tasty/KAT.hs0000644000000000000000000000713612457516336014642 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Test.Tasty.KAT -- License : MIT -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- -- Tasty support for KAT (Known Answer Tests) -- module Test.Tasty.KAT ( -- * Run tests testKatDetailed , testKatGrouped -- * Load KAT resources , testKatLoad , Resource(..) , katLoaderSimple , mapTestUnits ) where import Control.Applicative import Control.Exception import Data.Typeable import Test.Tasty (testGroup) import Test.Tasty.Providers import Test.Tasty.KAT.FileLoader newtype Resource a = Resource [(String, [a])] data TestKatSingle = TestKatSingle (IO Bool) deriving Typeable data TestKatGroup = TestKatGroup [(Int, IO Bool)] deriving Typeable data KatResult = KatFailed String | KatSuccess deriving (Show,Eq) tryResult :: IO Bool -> IO KatResult tryResult f = do er <- try f case er of Left (e :: SomeException) | show e == "<>" -> throwIO e | otherwise -> return $ KatFailed (show e) Right r -> return $ if r then KatSuccess else KatFailed "test failed" instance IsTest TestKatSingle where run _ (TestKatSingle tst) _ = do r <- tryResult tst case r of KatSuccess -> return $ testPassed "" KatFailed s -> return $ testFailed s testOptions = return [] instance IsTest TestKatGroup where run _ (TestKatGroup groupTests) _ = do (success, failed) <- summarize <$> mapM runGroup groupTests return $ (if failed == 0 then testPassed else testFailed) (if failed > 0 then (show failed) ++ " tests failed on " ++ show (failed + success) else (show success) ++ " tests succeed") where summarize :: [KatResult] -> (Int, Int) summarize = foldl (\(s,f) k -> if k == KatSuccess then (s+1,f) else (s,f+1)) (0,0) runGroup :: (Int, IO Bool) -> IO KatResult runGroup (_, tst) = tryResult tst --nbGroups = fromIntegral $ length groupTests --yieldProgress $ Progress { progressText = groupName, progressPercent = fromIntegral tstNb / nbGroups } testOptions = return [] -- | run one tasty test per vectors in each groups -- -- This is useful to have detailed output on what failed -- and what succeeded. For a more concise output, use -- 'testKatGrouped' testKatDetailed :: TestName -> Resource a -> (String -> a -> IO Bool) -> TestTree testKatDetailed name (Resource groups) test = -- singleTest name $ mkTestKat resource test testGroup name $ map groupToTests groups where groupToTests (groupName, vectors) = testGroup groupName $ map (\(i, v) -> singleTest (show (i :: Int)) (TestKatSingle $ test groupName v)) (zip [1..] vectors) -- | run one tasty test per group testKatGrouped :: TestName -> Resource a -> (String -> a -> IO Bool) -> TestTree testKatGrouped name (Resource groups) test = -- singleTest name $ mkTestKat resource test testGroup name $ map groupToTests groups where groupToTests (groupName, vectors) = singleTest groupName $ TestKatGroup $ map (\(i, v) -> (i, test groupName v)) (zip [1..] vectors) -- | Read a KAT file into values that will be used for KATs tests testKatLoad :: FilePath -> ([String] -> [(String, [a])]) -> IO (Resource a) testKatLoad filepath transform = Resource . transform . lines <$> readFile filepath tasty-kat-0.0.3/Test/Tasty/KAT/0000755000000000000000000000000012457516336014277 5ustar0000000000000000tasty-kat-0.0.3/Test/Tasty/KAT/FileLoader.hs0000644000000000000000000001755012457516336016651 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Test.Tasty.KAT.FileLoader -- License : MIT -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- -- extra loaders helpers -- module Test.Tasty.KAT.FileLoader ( katLoader , katLoaderSimple -- * generic helpers on TestResource , mapTestUnitValues , mapTestUnits -- * common helpers on TestResource , mapTestUnitValuesBase64 , mapTestUnitValuesBase16 -- * common value decoding helpers , valueUnbase16 , valueUnbase64 , valueInteger , valueHexInteger -- * associated hierarchy of KAT types , TestResource , TestGroup , TestUnit ) where import Control.Arrow (second) import Data.Bits import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Unsafe as B import Data.ByteString (ByteString) import Data.ByteString.Char8 () -- for Bytestring OverloadedString instance on old ghc import Data.List import Data.Word import Foreign.Storable import Foreign.Ptr import Test.Tasty.KAT.Internal type TestResource a = [(String, TestGroup a)] type TestGroup a = [TestUnit a] type TestUnit a = [a] -- | From a simple KAT file, extract -- -- * lines starting by #, are assumed to be comment -- -- format should be the following: -- -- > skipped .. -- > skipped .. -- > [group1] -- > -- > f1= v1 -- > f2= v2 -- > ... -- > -- > f1= v3 -- > f2= v4 -- > ... -- > -- > [group2] -- > ... katLoaderSimple :: [String] -> TestResource (String, String) katLoaderSimple = katLoader '=' "#" katLoader :: Char -- ^ key value separator, e.g. '=' -> String -- ^ line comment, e.g. "--" "#" -> [String] -- ^ input lines -> TestResource (String, String) katLoader kvSep lineComment = map (second (map (map kv))) . removeEmpty . map (second (splitWhen null)) -- split a group of lines into a group of tests . groupify "" [] . map noTrailing . filter (not . isComment) where isComment = isPrefixOf lineComment removeEmpty = filter ((/= []) . snd) groupify :: String -> [String] -> [String] -> [(String, [String])] groupify gname acc [] = [(gname, reverse acc)] groupify gname acc (x:xs) = case getGroupHeader x of Just hdr -> (gname, reverse acc) : groupify hdr [] xs Nothing -> groupify gname (x:acc) xs kv :: String -> (String, String) kv s = case break (== kvSep) s of (k, c:v) | c == kvSep -> (stripSpaces k, stripSpaces v) | otherwise -> (stripSpaces k, stripSpaces v) (_, _) -> (s, "") -- no error handling .. getGroupHeader :: String -> Maybe String getGroupHeader s | isPrefixOf "[" s && isSuffixOf "]" s = Just . drop 1 . reverse . drop 1 . reverse $ s | otherwise = Nothing noTrailing = reverse . dropWhile (== ' ') . reverse splitWhen :: (a -> Bool) -> [a] -> [[a]] splitWhen p s = case dropWhile p s of [] -> [] s' -> w : splitWhen p s'' where (w, s'') = break p s' stripSpaces = dropWhile (== ' ') . reverse . dropWhile (== ' ') . reverse mapTestUnitValues :: (String -> a) -> TestResource (String, String) -> TestResource (String,a) mapTestUnitValues f = map (second (map (map (\(k,v) -> (k, f v))))) mapTestUnits :: (TestUnit (String,a) -> TestUnit b) -> TestResource (String,a) -> TestResource b mapTestUnits f = map (second (map f)) mapTestUnitValuesBase64 :: TestResource (String, String) -> TestResource (String, ByteString) mapTestUnitValuesBase64 = mapTestUnitValues valueUnbase64 mapTestUnitValuesBase16 :: TestResource (String, String) -> TestResource (String, ByteString) mapTestUnitValuesBase16 = mapTestUnitValues valueUnbase16 -- expect an ascii string. valueUnbase64 :: String -> ByteString valueUnbase64 s | (length s `mod` 4) /= 0 = error ("decodiong base64 not proper length: " ++ s) | otherwise = unsafeCreateUptoN maxSz $ \ptr -> do szRemove <- loop s ptr return (maxSz - szRemove) where maxSz = (length s `div` 4) * 3 loop [] _ = return 0 loop (w:x:'=':'=':[]) ptr = do let w' = rset w x' = rset x poke ptr ((w' `shiftL` 2) .|. (x' `shiftR` 4)) return 2 loop (w:x:y:'=':[]) ptr = do let w' = rset w x' = rset x y' = rset y poke ptr ((w' `shiftL` 2) .|. (x' `shiftR` 4)) poke (ptr `plusPtr` 1) ((x' `shiftL` 4) .|. (y' `shiftR` 2)) return 1 loop (w:x:y:z:r) ptr = do let w' = rset w x' = rset x y' = rset y z' = rset z poke ptr ((w' `shiftL` 2) .|. (x' `shiftR` 4)) poke (ptr `plusPtr` 1) ((x' `shiftL` 4) .|. (y' `shiftR` 2)) poke (ptr `plusPtr` 2) ((y' `shiftL` 6) .|. z') loop r (ptr `plusPtr` 3) loop _ _ = error ("internal error in base64 decoding") rset :: Char -> Word8 rset c | cval <= 0xff = B.unsafeIndex rsetTable cval | otherwise = 0xff where cval = fromEnum c -- dict = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" rsetTable = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x3e\xff\xff\xff\x3f\ \\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\xff\xff\xff\xff\xff\xff\ \\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\ \\x0f\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\xff\xff\xff\xff\xff\ \\xff\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\ \\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\ \\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff" -- expect an ascii string. valueUnbase16 :: String -> ByteString valueUnbase16 s | odd (length s) = error ("decoding base16 not proper length: " ++ s) | otherwise = B.unsafeCreate (length s `div` 2) (loop s) where loop [] _ = return () loop (x1:x2:xs) ptr = do poke ptr ((unhex x1 `shiftL` 4) .|. unhex x2) loop xs (ptr `plusPtr` 2) loop _ _ = error "internal error in base16 decoding" unhex :: Char -> Word8 unhex c | c >= '0' && c <= '9' = fromIntegral (fromEnum c - fromEnum '0') | c >= 'a' && c <= 'f' = 10 + fromIntegral (fromEnum c - fromEnum 'a') | c >= 'A' && c <= 'F' = 10 + fromIntegral (fromEnum c - fromEnum 'A') | otherwise = error ("invalid base16 character " ++ show c ++ " in " ++ show s) valueInteger :: String -> Integer valueInteger s = read s valueHexInteger :: String -> Integer valueHexInteger s = read ("0x" ++ s) tasty-kat-0.0.3/Test/Tasty/KAT/Internal.hs0000644000000000000000000000144012457516336016406 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | -- Module : Test.Tasty.KAT.Internal -- License : MIT -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : Good -- -- compat -- module Test.Tasty.KAT.Internal ( unsafeCreateUptoN ) where import qualified Data.ByteString.Internal as B import Data.ByteString (ByteString) import Foreign.Ptr import Data.Word #if !(MIN_VERSION_bytestring(0,10,4)) import Foreign.ForeignPtr import System.IO.Unsafe (unsafePerformIO) #endif unsafeCreateUptoN :: Int -> (Ptr Word8 -> IO Int) -> ByteString #if MIN_VERSION_bytestring(0,10,4) unsafeCreateUptoN = B.unsafeCreateUptoN #else unsafeCreateUptoN len f = unsafePerformIO $ do fp <- B.mallocByteString len l' <- withForeignPtr fp f return $! B.PS fp 0 l' #endif tasty-kat-0.0.3/tests/0000755000000000000000000000000012457516336012777 5ustar0000000000000000tasty-kat-0.0.3/tests/KAT0000644000000000000000000000033512457516336013342 0ustar0000000000000000# comment # another comment [add] a = 123 b = 3 r = 126 a = 12 b = 24 r = 36 [sub] # a comment a = 123 b = 3 r = 120 # a similar group [add] a = 10 b = 12 r = 22 [base64] a = YWJj r = abc a = YWJjZA== r = abcd tasty-kat-0.0.3/tests/Tests.hs0000644000000000000000000000305012457516336014433 0ustar0000000000000000module Main where import Test.Tasty import Test.Tasty.KAT import Test.Tasty.KAT.FileLoader import qualified Data.ByteString.Char8 as BC main = do kat <- testKatLoad "tests/KAT" katLoaderSimple defaultMain $ testGroup "tasty-kat" [ testKatDetailed "kat-detailed" kat myTest , testKatGrouped "kat-grouped" kat myTest ] where myTest group kvs = case group of "add" -> case sequence $ map (flip lookup kvs) ["a","b","r"] of Just [as,bs,rs] -> let a = read as :: Int b = read bs :: Int r = read rs :: Int in return (a + b == r) _ -> error ("invalid vector " ++ show kvs) "sub" -> case sequence $ map (flip lookup kvs) ["a","b","r"] of Just [as,bs,rs] -> let a = read as :: Int b = read bs :: Int r = read rs :: Int in return (a - b == r) _ -> error "invalid vector" "base64" -> case sequence $ map (flip lookup kvs) ["a","r"] of Just [as,rs] -> return ((valueUnbase64 as) == (BC.pack rs)) _ -> error "invalid vector" _ -> error ("unknown group: " ++ group)