2026-01-12 16:10:51 -05:00
|
|
|
module Main (main) where
|
|
|
|
|
|
|
|
|
|
import Datalog
|
2026-01-16 01:05:19 -05:00
|
|
|
|
2026-01-12 16:10:51 -05:00
|
|
|
import Data.Text qualified as T
|
|
|
|
|
import Data.Text.IO qualified as T
|
|
|
|
|
|
2026-01-16 01:05:19 -05:00
|
|
|
import Test.Tasty
|
|
|
|
|
import Test.Tasty.HUnit
|
|
|
|
|
|
|
|
|
|
golden :: (Show err, Show val) => String -> String -> (FilePath -> IO (Either err val)) -> IO ()
|
|
|
|
|
golden outExt prefix run = do
|
2026-01-12 16:10:51 -05:00
|
|
|
let inFile = "test/golden/" <> prefix <> ".dl"
|
2026-01-16 01:05:19 -05:00
|
|
|
outFile = "test/golden/" <> prefix <> outExt
|
|
|
|
|
res <- run inFile
|
2026-01-12 16:10:51 -05:00
|
|
|
out <- T.readFile outFile
|
2026-01-16 01:05:19 -05:00
|
|
|
case res of
|
|
|
|
|
Left e -> assertFailure (show e)
|
|
|
|
|
Right out' -> assertEqual "" (T.strip out) (T.pack (show out'))
|
|
|
|
|
|
|
|
|
|
parserGoldenTest :: String -> TestTree
|
|
|
|
|
parserGoldenTest prefix = testCase ("Parser test: " <> prefix) $ golden ".show" prefix readProgram
|
|
|
|
|
|
|
|
|
|
{-
|
|
|
|
|
databaseGoldenTest :: String -> TestTree
|
|
|
|
|
databaseGoldenTest prefix = testCase ("Database test: " <> prefix) $ golden ".db0" prefix readDatabase
|
|
|
|
|
|
|
|
|
|
fixedpointGoldenTest :: String -> TestTree
|
|
|
|
|
fixedpointGoldenTest prefix = testCase ("Fixedpoint test: " <> prefix) $ golden ".dbF" prefix $ \fp -> do
|
|
|
|
|
fmap (fmap extendFixedpointDb) (readDatabase fp)
|
|
|
|
|
-}
|
2026-01-12 16:10:51 -05:00
|
|
|
|
|
|
|
|
main :: IO ()
|
2026-01-16 01:05:19 -05:00
|
|
|
main = defaultMain $
|
|
|
|
|
testGroup "all"
|
|
|
|
|
[ testGroup "parser"
|
|
|
|
|
[ parserGoldenTest "ancestor"
|
|
|
|
|
, parserGoldenTest "graph"
|
|
|
|
|
]
|
|
|
|
|
]
|