never executed always true always false

    1 module Conjure.ParserFuzz (tests) where
    2 
    3 import Conjure.Language.AST.ASTParser (parseProgram, runASTParser)
    4 import Conjure.Language.AST.Reformer (flattenSeq)
    5 import Conjure.Language.Lexer (reformList, runLexer)
    6 import Conjure.Prelude
    7 import Data.Algorithm.Diff (getGroupedDiff)
    8 import Data.Algorithm.DiffOutput (ppDiff)
    9 import Data.ByteString.Char8 (hPutStrLn, pack)
   10 import Data.Text qualified as T (pack, unpack)
   11 import Data.Text.Lazy qualified as L
   12 import GHC.IO.Handle.FD (stderr)
   13 import Shelly (run, shelly, silently)
   14 import Test.Tasty (TestTree, testGroup)
   15 import Test.Tasty.HUnit (assertFailure, testCaseSteps)
   16 
   17 tests :: IO TestTree
   18 tests = do
   19   allFiles <- shelly $ silently $ run "git" ["ls-tree", "--full-tree", "--name-only", "-r", "HEAD"]
   20   let allFileList = lines $ T.unpack allFiles
   21   let testCases = testFile <$> allFileList
   22   return (testGroup "parse_fuzz" testCases)
   23 
   24 testFile :: FilePath -> TestTree
   25 testFile fp = testCaseSteps (map (\ch -> if ch == '/' then '.' else ch) fp) $ \step -> do
   26   fd <- readFileIfExists fp
   27   step "lexing"
   28   let usableFileData = concat (take 1000 . lines $ fromMaybe [] fd)
   29   let fText = T.pack usableFileData
   30   case runLexer fText (Just fp) of
   31     Left _le -> assertFailure $ "Lexer failed in:" ++ fp
   32     Right ets -> do
   33       step "parsing"
   34       case runASTParser parseProgram ets of
   35         Left _pe -> assertFailure $ "Parser failed in:" ++ fp
   36         Right pt -> do
   37           step "round tripping"
   38           let roundTrip = L.unpack $ reformList $ flattenSeq pt
   39           unless (roundTrip == usableFileData) $ do
   40             let diff = getGroupedDiff (lines roundTrip) (lines usableFileData)
   41             Data.ByteString.Char8.hPutStrLn stderr $ Data.ByteString.Char8.pack $ "===DIFF: " ++ fp
   42             Data.ByteString.Char8.hPutStrLn stderr $ Data.ByteString.Char8.pack $ ppDiff diff
   43             Data.ByteString.Char8.hPutStrLn stderr "===------------"
   44             assertFailure $ "Failed to rebuild :" ++ fp