quebex

 1-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
 2--
 3-- SPDX-License-Identifier: GPL-3.0-only
 4
 5module Golden (goldenTests) where
 6
 7import Data.List (find)
 8import Language.QBE (globalFuncs, parse)
 9import Language.QBE.Simulator.Explorer (defSolver, explore, newEngine)
10import Language.QBE.Types qualified as QBE
11import System.FilePath
12import Test.Tasty
13import Test.Tasty.Golden.Advanced
14
15type Result = Int
16
17entryFunc :: QBE.GlobalIdent
18entryFunc = QBE.GlobalIdent "entry"
19
20exploreQBE :: FilePath -> [(String, QBE.BaseType)] -> IO Result
21exploreQBE filePath params = do
22  content <- readFile filePath
23  prog <- case parse filePath content of
24    Right rt -> pure rt
25    Left err -> fail $ "Parsing error: " ++ show err
26
27  let funcs = globalFuncs prog
28  func <- case find (\f -> QBE.fName f == entryFunc) funcs of
29    Just x -> pure x
30    Nothing -> fail $ "Unable to find entry function: " ++ show entryFunc
31
32  engine <- defSolver >>= newEngine
33  traces <- explore engine prog func params
34  pure $ length traces
35
36simpleCmp :: Result -> Result -> IO (Maybe String)
37simpleCmp expt act =
38  return $
39    if expt == act
40      then Nothing
41      else Just ("Exploration mismatch: " ++ err)
42  where
43    err :: String
44    err = "expected=" ++ show expt ++ " actual=" ++ show act
45
46runTest :: TestName -> Int -> [(String, QBE.BaseType)] -> TestTree
47runTest testName expPaths params =
48  goldenTest
49    testName
50    (pure expPaths)
51    (exploreQBE fullPath params)
52    simpleCmp
53    (\_ -> pure ())
54  where
55    fullPath :: FilePath
56    fullPath = "test" </> "golden" </> (testName ++ ".qbe")
57
58------------------------------------------------------------------------
59
60goldenTests :: TestTree
61goldenTests =
62  testGroup
63    "goldenTests"
64    [ runTest "three-branches" 3 [("a", QBE.Word), ("b", QBE.Word)],
65      runTest "prime-numbers" 21 [("a", QBE.Word)]
66    ]