qute

  1-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
  2-- SPDX-FileCopyrightText: 2026 Reliable System Software, Technische Universität Braunschweig <vss@ibr.cs.tu-bs.de>
  3--
  4-- SPDX-License-Identifier: GPL-3.0-only
  5
  6module Analysis (analTests) where
  7
  8import Data.Bifunctor (bimap)
  9import Data.List (sort)
 10import Language.QBE (parseAndFind)
 11import Language.QBE.Analysis.CDG qualified as CDG
 12import Language.QBE.Analysis.CFG qualified as CFG
 13import Language.QBE.Types qualified as QBE
 14import System.FilePath ((</>))
 15import Test.Tasty
 16import Test.Tasty.HUnit
 17
 18getFunction :: QBE.GlobalIdent -> String -> IO QBE.FuncDef
 19getFunction funcName input = snd <$> parseAndFind funcName input
 20
 21getFuncAndProg :: FilePath -> QBE.GlobalIdent -> IO QBE.FuncDef
 22getFuncAndProg fileName funcName =
 23  let filePath = "test" </> "testdata" </> fileName
 24   in readFile filePath >>= getFunction funcName
 25
 26toBlkName :: CFG.CFG -> CFG.Label -> String
 27toBlkName cfg = show . CFG.labelToIdent cfg
 28
 29cdgEdges :: CFG.CFG -> CDG.CDG -> [(String, String)]
 30cdgEdges cfg = map go . CDG.edges
 31  where
 32    go (f, t) = (toBlkName cfg f, toBlkName cfg t)
 33
 34cfgEdges :: CFG.CFG -> [(String, String)]
 35cfgEdges cfg =
 36  let toBlk = toBlkName cfg
 37   in sort $ map (bimap toBlk toBlk) (CFG.edges cfg)
 38
 39------------------------------------------------------------------------
 40
 41analTests :: TestTree
 42analTests =
 43  testGroup
 44    "Analysis tests"
 45    [ testCase "Simple CFG without any loops" $
 46        do
 47          func <-
 48            getFunction
 49              (QBE.GlobalIdent "foo")
 50              "function w $foo() {\n\
 51              \@start\n\
 52              \%val =w add 0, 1\n\
 53              \jmp @next\n\
 54              \@next\n\
 55              \ret\n\
 56              \}\n"
 57
 58          let cfg = CFG.build func
 59          let startLabel = CFG.identToLabel cfg $ QBE.BlockIdent "start"
 60          map (CFG.labelToIdent cfg) (CFG.lookupSuccs cfg startLabel)
 61            @?= [QBE.BlockIdent "next"]
 62
 63          cfgEdges cfg
 64            @?= [("@start", "@next")]
 65
 66          -- “If Y is control dependent on X then X must have two exits.“, in
 67          -- this CFG there are no nodes with two exits: The CDG must be emtpy.
 68          let ret = CFG.identToLabel cfg $ QBE.BlockIdent "next"
 69              cdg = CDG.build cfg ret
 70          cdgEdges cfg cdg @?= []
 71          CDG.ctrlDeps cdg ret @?= Nothing,
 72      testCase "Generate CDG for code with single branch" $
 73        do
 74          func <-
 75            getFunction
 76              (QBE.GlobalIdent "foo")
 77              "function w $foo() {\n\
 78              \@start\n\
 79              \%val =w add 0, 1\n\
 80              \jnz %val, @ifT, @ifF\n\
 81              \@ifT\n\
 82              \%ret =w copy 1\n\
 83              \jmp @return\n\
 84              \@ifF\n\
 85              \%ret =w copy 0\n\
 86              \jmp @return\n\
 87              \@return\n\
 88              \ret %ret\n\
 89              \}\n"
 90
 91          let cfg = CFG.build func
 92              ret = CFG.identToLabel cfg (QBE.BlockIdent "return")
 93              cdg = CDG.build cfg ret
 94
 95          cdgEdges cfg cdg
 96            @?= [ ("@ifF", "@start"),
 97                  ("@ifT", "@start")
 98                ],
 99      testCase "Compute CDG for code with loop" $
100        do
101          func <-
102            getFunction
103              (QBE.GlobalIdent "main")
104              "function w $main() {\n\
105              \@start\n\
106              \%.1 =w copy 0\n\
107              \%.2 =w copy 42\n\
108              \%.3 =w copy 0\n\
109              \@for_cond\n\
110              \%.6 =w csltw %.3, %.2\n\
111              \jnz %.6, @for_body, @for_join\n\
112              \@for_body\n\
113              \%.1 =w add %.1, 1\n\
114              \@for_cont\n\
115              \%.3 =w add %.3, 1\n\
116              \jmp @for_cond\n\
117              \@for_join\n\
118              \ret %.11\n\
119              \}\n"
120
121          let cfg = CFG.build func
122              ret = CFG.identToLabel cfg (QBE.BlockIdent "for_join")
123              cdg = CDG.build cfg ret
124
125          cdgEdges cfg cdg
126            @?= [ ("@for_body", "@for_cond"),
127                  ("@for_cond", "@for_cond"),
128                  ("@for_cont", "@for_cond")
129                ],
130      testCase "Compute CDG for code with two paths to node" $
131        do
132          func <- getFuncAndProg "disjunction.qbe" (QBE.GlobalIdent "main")
133
134          let cfg = CFG.build func
135              ret = CFG.identToLabel cfg (QBE.BlockIdent "return")
136              cdg = CDG.build cfg ret
137
138          cdgEdges cfg cdg
139            @?= [ ("@if_false.4", "@body.2"),
140                  ("@if_false.4", "@if_true.3"),
141                  ("@if_false.6", "@if_true.3"),
142                  ("@if_join.7", "@if_true.3"),
143                  ("@if_true.3", "@body.2"),
144                  ("@if_true.5", "@if_true.3")
145                ],
146      testCase "Compute dominators for a simple-cc representation" $
147        do
148          func <- getFuncAndProg "simple-cc-branches.qbe" (QBE.GlobalIdent "myfunc")
149
150          let cfg = CFG.build func
151          CFG.labelToIdent cfg (CFG.startNode cfg)
152            @?= QBE.BlockIdent ".L9"
153    ]