qute

  1-- SPDX-FileCopyrightText: 2026 Sören Tempel <soeren+git@soeren-tempel.net>
  2--
  3-- SPDX-License-Identifier: GPL-3.0-only
  4
  5module Linker (linkerTests) where
  6
  7import Control.Exception (throwIO)
  8import Data.List (find)
  9import Data.Maybe (mapMaybe)
 10import Language.QBE
 11  ( Definition (DefData, DefType),
 12    ExecError (EUnknownEntry),
 13    Program,
 14    globalFuncs,
 15    localDefs,
 16    parse,
 17    typeDefs,
 18  )
 19import Language.QBE.Linker (link)
 20import Language.QBE.Types qualified as QBE
 21import System.FilePath ((</>))
 22import Test.Tasty
 23import Test.Tasty.HUnit
 24import Util (parseArchive)
 25
 26parseFile :: FilePath -> IO Program
 27parseFile fileName = do
 28  content <- readFile $ "test" </> "testdata" </> "linker" </> fileName
 29  case parse fileName content of
 30    Right prog -> pure prog
 31    Left err -> throwIO err
 32
 33findData :: Program -> [QBE.DataDef]
 34findData = mapMaybe getData
 35  where
 36    getData :: Definition -> Maybe QBE.DataDef
 37    getData (DefData dataDef) = Just dataDef
 38    getData _ = Nothing
 39
 40findFunc :: Program -> String -> IO QBE.FuncDef
 41findFunc prog name = do
 42  let funcs = globalFuncs prog
 43      entryIdent = QBE.GlobalIdent name
 44  case find (\f -> QBE.fName f == entryIdent) funcs of
 45    Just x -> pure x
 46    Nothing -> throwIO $ EUnknownEntry entryIdent
 47
 48findType :: Program -> String -> IO QBE.TypeDef
 49findType prog name = do
 50  let toFind = QBE.UserIdent name
 51  case find (isType toFind) prog of
 52    Just (DefType ty) -> pure ty
 53    _ -> fail $ "unknown type '" ++ show toFind ++ "'"
 54  where
 55    isType toFind (DefType ty) = QBE.aggName ty == toFind
 56    isType _ _ = False
 57
 58------------------------------------------------------------------------
 59
 60linkerTests :: TestTree
 61linkerTests =
 62  testGroup
 63    "Test the QBE Linker"
 64    [ testCase "Link file with same data definition" $
 65        do
 66          prog <- parseFile "data-definition-and-call.qbe"
 67          let linked = link [prog, prog]
 68
 69          map QBE.name (findData linked)
 70            @?= [QBE.GlobalIdent ".L116", QBE.GlobalIdent ".L116.QG1"]
 71
 72          func <- findFunc (reverse linked) "__assert"
 73          let block = QBE.fEntry func
 74              funcVal = QBE.VConst (QBE.Const $ QBE.Global (QBE.GlobalIdent "error"))
 75              funcArg =
 76                QBE.ArgReg
 77                  (QBE.ABase QBE.Long)
 78                  (QBE.VConst (QBE.Const $ QBE.Global (QBE.GlobalIdent ".L116.QG1")))
 79          QBE.stmt block @?= [QBE.Call Nothing funcVal [funcArg]],
 80      testCase "Link files with helper function" $
 81        do
 82          progs <- parseArchive "linker/same-helper-function.ar"
 83          let linked = link progs
 84
 85          localDefs linked
 86            @?= [QBE.GlobalIdent "myhelper", QBE.GlobalIdent "myhelper.QG1"]
 87
 88          func <- findFunc linked "myfunc2"
 89          let block = QBE.fEntry func
 90              funcVal = QBE.VConst (QBE.Extern $ QBE.GlobalIdent "callback")
 91              funcArg =
 92                QBE.ArgReg
 93                  (QBE.ABase QBE.Long)
 94                  (QBE.VConst (QBE.Extern $ QBE.GlobalIdent "myhelper.QG1"))
 95          QBE.stmt block @?= [QBE.Call Nothing funcVal [funcArg]],
 96      testCase "Data reference within a data definition" $
 97        do
 98          prog <- parseFile "data-reference-in-data-definition.qbe"
 99          let linked = link [prog, prog]
100
101          -- TODO: actually check the data mamber
102          localDefs linked
103            @?= [ QBE.GlobalIdent "somedata",
104                  QBE.GlobalIdent "moredata",
105                  QBE.GlobalIdent "somedata.QG1",
106                  QBE.GlobalIdent "moredata.QG1"
107                ],
108      testCase "Link files with conflicting type definition" $
109        do
110          progs <- parseArchive "linker/same-type-in-function-return.ar"
111          let linked = link progs
112
113          typeDefs linked
114            @?= [QBE.UserIdent "retTy", QBE.UserIdent "retTy.QU1"]
115
116          func <- findFunc linked "idivmax"
117          QBE.fAbity func @?= Just (QBE.AUserDef $ QBE.UserIdent "retTy.QU1"),
118      testCase "Type definition with fields" $
119        do
120          prog <- parseFile "type-definition-with-fields.ar"
121          let linked = link [prog, prog]
122
123          typeDefs linked
124            @?= [ QBE.UserIdent "type.39",
125                  QBE.UserIdent "type.38",
126                  QBE.UserIdent "something",
127                  QBE.UserIdent "type.39.QU1",
128                  QBE.UserIdent "type.38.QU1",
129                  QBE.UserIdent "something.QU1"
130                ]
131
132          ty1 <- findType linked "something.QU1"
133          ty1
134            @?= QBE.TypeDef
135              (QBE.UserIdent "something.QU1")
136              Nothing
137              (QBE.AUnion [[(QBE.SUserDef $ QBE.UserIdent "type.38.QU1", Just 1)]])
138
139          ty2 <- findType linked "type.38.QU1"
140          ty2
141            @?= QBE.TypeDef
142              (QBE.UserIdent "type.38.QU1")
143              (Just 8)
144              ( QBE.ARegular
145                  [ (QBE.SExtType $ QBE.Base QBE.Long, Just 1),
146                    (QBE.SUserDef $ QBE.UserIdent "type.39.QU1", Just 1)
147                  ]
148              )
149    ]