77 lines
2.8 KiB
Haskell
77 lines
2.8 KiB
Haskell
|
import qualified Test.HUnit as HUnit
|
||
|
|
import qualified System.IO as IO
|
||
|
|
import qualified Text.ParserCombinators.Parsec as Parsec
|
||
|
|
import qualified Data.List as List
|
||
|
|
import qualified Data.Maybe as Maybe
|
||
|
|
import qualified Text.Regex as RE
|
||
|
|
import qualified System.Directory as Dir
|
||
|
|
|
||
|
|
import Registry.Grammar
|
||
|
|
import Registry.Types
|
||
|
|
import Registry.Registry
|
||
|
|
|
||
|
|
brokenDir = "./broken-registries"
|
||
|
|
correctDir = "./correct-registries"
|
||
|
|
invalidDir = "./invalid-registries"
|
||
|
|
validDir = "./valid-registries"
|
||
|
|
|
||
|
|
data RegistryText = Registry {filename::FilePath, filecontents::String}
|
||
|
|
|
||
|
|
buildTestCaseSyn :: Bool -> RegistryText -> HUnit.Test
|
||
|
|
buildTestCaseSyn True reg =
|
||
|
|
HUnit.TestCase (HUnit.assertBool ("Should be syntactically OK (" ++ (filename reg) ++ ")")
|
||
|
|
(checkOK (parse (filecontents reg))))
|
||
|
|
buildTestCaseSyn False reg =
|
||
|
|
HUnit.TestCase (HUnit.assertBool ("Should be syntactically wrong (" ++ (filename reg) ++ ")")
|
||
|
|
(not (checkOK (parse (filecontents reg)))))
|
||
|
|
|
||
|
|
buildTestCaseSem :: Bool -> RegistryText -> HUnit.Test
|
||
|
|
buildTestCaseSem True reg =
|
||
|
|
let registry = parse (filecontents reg) in
|
||
|
|
HUnit.TestCase (HUnit.assertBool ("Should be valid (" ++ (filename reg) ++ ")")
|
||
|
|
(checkOK (registry) &&
|
||
|
|
checkOK (semanticCheck (registryOf registry))))
|
||
|
|
buildTestCaseSem False reg =
|
||
|
|
let registry = parse (filecontents reg) in
|
||
|
|
HUnit.TestCase (HUnit.assertBool ("Should be invalid (" ++ (filename reg) ++ ")")
|
||
|
|
(checkOK (registry) &&
|
||
|
|
not (checkOK (semanticCheck (registryOf registry)))))
|
||
|
|
|
||
|
|
endsWith :: String -> String -> Bool
|
||
|
|
endsWith s1 s2 = Maybe.isJust (RE.matchRegex (RE.mkRegex (s2 ++ "$")) s1)
|
||
|
|
|
||
|
|
-- TODO: use mapM instead
|
||
|
|
foreach :: (Monad m) => [a1] -> (a1 -> m a) -> m [a]
|
||
|
|
foreach [] func = do
|
||
|
|
return []
|
||
|
|
foreach x func = do
|
||
|
|
newHead <- func (head x)
|
||
|
|
newTail <- foreach (tail x) func
|
||
|
|
return (newHead : newTail)
|
||
|
|
|
||
|
|
contentOf :: FilePath -> IO RegistryText
|
||
|
|
contentOf f = do
|
||
|
|
content <- IO.readFile f
|
||
|
|
return (Registry f content)
|
||
|
|
|
||
|
|
addDir d f = d ++ "/" ++ f
|
||
|
|
|
||
|
|
filesOf :: FilePath -> IO [RegistryText]
|
||
|
|
filesOf d = do
|
||
|
|
files <- Dir.getDirectoryContents d
|
||
|
|
foreach (map (addDir d) (filter (\n -> n /= "." && n /= ".." && (not (endsWith n "~")))
|
||
|
|
files))
|
||
|
|
contentOf
|
||
|
|
|
||
|
|
main = do
|
||
|
|
brokenFiles <- filesOf brokenDir
|
||
|
|
let testsBroken = map (buildTestCaseSyn False) brokenFiles
|
||
|
|
invalidFiles <- filesOf invalidDir
|
||
|
|
let testsInvalid = map (buildTestCaseSem False) invalidFiles
|
||
|
|
correctFiles <- filesOf correctDir
|
||
|
|
let testsCorrect = map (buildTestCaseSyn True) correctFiles
|
||
|
|
validFiles <- filesOf validDir
|
||
|
|
let testsValid = map (buildTestCaseSem True) validFiles
|
||
|
|
HUnit.runTestTT (HUnit.TestList (testsBroken ++ testsInvalid ++
|
||
|
|
testsCorrect ++ testsValid))
|