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