Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 8a4a92250b
Fetching contributors…

Cannot retrieve contributors at this time

102 lines (82 sloc) 3.339 kb
module Main where
import Hasktags
import Tags
import Control.Monad
import Data.List
import System.Directory
import System.Exit
import qualified Data.ByteString.Char8 as BS
import Test.HUnit
{- TODO
Test the library (recursive, caching, ..)
But that's less likely to break
-}
-- all comments should differ at the beginning
comments :: [BS.ByteString] -> String -> [String]
comments lns comment = filter (not . null) $ map hitOrEmpty lns
where
c = BS.pack $ comment ++ " "
hitOrEmpty :: BS.ByteString -> String
hitOrEmpty bs =
let ds = BS.dropWhile (== ' ') bs
in if c `BS.isPrefixOf` ds
then BS.unpack $ BS.drop (BS.length c) ds
else ""
tagComments :: [BS.ByteString] -> String -> [String]
tagComments lns comment
= map (takeWhile (not . (`elem` "\n\r "))) $ comments lns comment
testToBeFound :: [String] -> [String] -> Test
testToBeFound foundTagNames toBeFound =
"these were not found"
~: [] ~=? filter (not . (`elem` foundTagNames)) toBeFound
testNotToBeFound :: [String] -> [String] -> Test
testNotToBeFound foundTagNames notToBeFound =
"these should not have been found"
~: [] ~=? filter (`elem` foundTagNames) notToBeFound
testToBeFoundOnce :: [String] -> [String] -> Test
testToBeFoundOnce foundTagNames list =
"these should have been found exactly one time"
~: []
~=? [name
| name <- list, 1 /= length (filter (== name ) foundTagNames)]
etagsToBeFound :: String -> [String] -> Test
etagsToBeFound etags toBeFound =
"these were not found on TAGS"
~: [] ~=? filter (not . (`isInfixOf` etags)) toBeFound
etagsNotToBeFound :: String -> [String] -> Test
etagsNotToBeFound etags notToBeFound =
"these should not have been found on TAGS"
~: [] ~=? filter (`isInfixOf` etags) notToBeFound
etagsToBeFoundOnce :: String -> [String] -> Test
etagsToBeFoundOnce etags list =
"these should not have been found on TAGS"
~: [] ~=? [ name | name <- list, 1 /= length (infixes name etags)]
infixes :: Eq a => [a] -> [a] -> [[a]]
infixes needle haystack = filter (isPrefixOf needle) (tails haystack)
createTestCase :: FilePath -> IO Test
createTestCase filename = do
bs <- BS.readFile filename
let lns = BS.lines bs
let fd = findThingsInBS True filename bs
let FileData _ things = fd
let foundTagNames = [name | FoundThing _ name _ <- things]
let etags = etagsDumpFileData fd
let testList = TestList [
testToBeFound foundTagNames (tagComments lns "-- to be found"),
testNotToBeFound foundTagNames (tagComments lns "-- not to be found"),
testToBeFoundOnce
foundTagNames
(tagComments lns "-- once to be found"),
etagsToBeFound etags (comments lns "-- TAGS to be found"),
etagsNotToBeFound etags (comments lns "-- TAGS not to be found"),
etagsToBeFoundOnce etags (comments lns "-- TAGS once to be found")
]
return $ filename ~: testList
main :: IO ()
main
= do
setCurrentDirectory "testcases"
files <- getDirectoryContents "."
tests <- mapM createTestCase $ filter (not . (`elem` [".", "..", "expected_failures_testing_suite.hs"])) files
counts_ <- runTestTT $ TestList tests
when (errors counts_ + failures counts_ > 0) exitFailure
Jump to Line
Something went wrong with that request. Please try again.