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 (explore)
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  traces <- explore prog func params
33  pure $ length traces
34
35simpleCmp :: Result -> Result -> IO (Maybe String)
36simpleCmp expt act =
37  return $
38    if expt == act
39      then Nothing
40      else Just ("Exploration mismatch: " ++ err)
41  where
42    err :: String
43    err = "expected=" ++ show expt ++ " actual=" ++ show act
44
45runTest :: TestName -> Int -> [(String, QBE.BaseType)] -> TestTree
46runTest testName expPaths params =
47  goldenTest
48    testName
49    (pure expPaths)
50    (exploreQBE fullPath params)
51    simpleCmp
52    (\_ -> pure ())
53  where
54    fullPath :: FilePath
55    fullPath = "test" </> "golden" </> (testName ++ ".qbe")
56
57------------------------------------------------------------------------
58
59goldenTests :: TestTree
60goldenTests =
61  testGroup
62    "goldenTests"
63    [ runTest "three-branches" 3 [("a", QBE.Word), ("b", QBE.Word)],
64      runTest "prime-numbers" 21 [("a", QBE.Word)]
65    ]