tree-features: ae4a85503b765f0d5fedfa280e76942d07d971a7

     1: module SexprTests (tests, sanitise, exampleAsts) where
     2: 
     3: import           Test.Tasty (testGroup)
     4: import Test.Tasty.QuickCheck (testProperty)
     5: import Test.QuickCheck
     6: import Text.Parsec
     7: import SexprHelper
     8: import Features
     9: import FeatureTest (sizedTreeOf)
    10: import System.IO.Unsafe
    11: import System.Directory
    12: 
    13: -- | Strip potentially unparsable characters from a string
    14: sanitise :: String -> String
    15: sanitise s = let keep c = c /= '"' && c /= '\\'
    16:              in  filter keep (show s)
    17: 
    18: quote x = concat ["\"", x, "\""]
    19: 
    20: canParseLeaf s' = let s = sanitise s'
    21:                       t = parseSexpr (quote s)
    22:                    in t == Leaf s
    23: 
    24: canParseFlatNode :: [String] -> Bool
    25: canParseFlatNode ss' = let ss = map sanitise ss'
    26:                            t  = parseSexpr (concat ["(",
    27:                                                     unwords (map quote ss),
    28:                                                     ")"])
    29:                         in t == Node (map Leaf ss)
    30: 
    31: -- NOTE: Parsed trees might not equal the incoming trees!
    32: canParseRenderedTrees :: Int -> Property
    33: canParseRenderedTrees n = forAll (sizedTreeOf n :: Gen (TreeOf String))
    34:                                  parses
    35:   where parses t' = let t  = fmap sanitise t'
    36:                      in forceTree (parseSexpr (treeToSexpr t))
    37: 
    38: parsedTreesEqualRendered :: Int -> Property
    39: parsedTreesEqualRendered n = forAll (sizedTreeOf n :: Gen (TreeOf String))
    40:                                     parses
    41:   where parses t' = let t  = fmap sanitise t'
    42:                         t2 = parseSexpr (treeToSexpr t)
    43:                      in t2 == t
    44: 
    45: {-# NOINLINE exampleAsts #-}
    46: exampleAsts = unsafePerformIO $ do files <- getDirectoryContents dir
    47:                                    let asts = filter isAst files
    48:                                    mapM (readFile . (dir ++)) asts
    49:   where dir = "test/data/good/"
    50:         isAst f = reverse (take 4 (reverse f)) == ".ast"
    51: 
    52: forceTree :: TreeOf a -> Bool
    53: forceTree (Leaf _)  = True
    54: forceTree (Node xs) = all forceTree xs
    55: 
    56: canParseHS2ASTOutput :: Bool
    57: canParseHS2ASTOutput = all parser exampleAsts
    58:   where parser ast = forceTree (parseSexpr ast)
    59: 
    60: tests = testGroup "S-expression tests"
    61:           [
    62:             testProperty "canParseLeaf" canParseLeaf
    63:           , testProperty "canParseFlatNode" canParseFlatNode
    64:           , testProperty "canParseRenderedTrees" canParseRenderedTrees
    65:           , testProperty "canParseHS2ASTOutput" canParseHS2ASTOutput
    66:           , testProperty "parsedTreesEqualRendered" parsedTreesEqualRendered
    67:           ]