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.Bifunctor (second)
 8import Data.List (find)
 9import Language.QBE (globalFuncs, parse)
10import Language.QBE.Simulator.Concolic.State (mkEnv)
11import Language.QBE.Simulator.Explorer (defSolver, explore, newEngine)
12import Language.QBE.Types qualified as QBE
13import System.FilePath
14import Test.Tasty
15import Test.Tasty.Golden.Advanced
16
17type Result = Int
18
19entryFunc :: QBE.GlobalIdent
20entryFunc = QBE.GlobalIdent "entry"
21
22exploreQBE :: FilePath -> [(String, QBE.BaseType)] -> IO Result
23exploreQBE filePath params = do
24  content <- readFile filePath
25  prog <- case parse filePath content of
26    Right rt -> pure rt
27    Left err -> fail $ "Parsing error: " ++ show err
28
29  let funcs = globalFuncs prog
30  func <- case find (\f -> QBE.fName f == entryFunc) funcs of
31    Just x -> pure x
32    Nothing -> fail $ "Unable to find entry function: " ++ show entryFunc
33
34  engine <- newEngine <$> defSolver
35  defEnv <- mkEnv prog 0 128 Nothing
36  traces <-
37    explore engine defEnv func $
38      map (second QBE.Base) params
39  pure $ length traces
40
41simpleCmp :: Result -> Result -> IO (Maybe String)
42simpleCmp expt act =
43  return $
44    if expt == act
45      then Nothing
46      else Just ("Exploration mismatch: " ++ err)
47  where
48    err :: String
49    err = "expected=" ++ show expt ++ " actual=" ++ show act
50
51runTest :: TestName -> Int -> [(String, QBE.BaseType)] -> TestTree
52runTest testName expPaths params =
53  goldenTest
54    testName
55    (pure expPaths)
56    (exploreQBE fullPath params)
57    simpleCmp
58    (\_ -> pure ())
59  where
60    fullPath :: FilePath
61    fullPath = "test" </> "golden" </> (testName ++ ".qbe")
62
63------------------------------------------------------------------------
64
65goldenTests :: TestTree
66goldenTests =
67  testGroup
68    "goldenTests"
69    [ runTest "three-branches" 3 [("a", QBE.Word), ("b", QBE.Word)],
70      runTest "prime-numbers" 21 [("a", QBE.Word)],
71      runTest "address-concretization" 2 [("a", QBE.Word)]
72    ]