1-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>2--3-- SPDX-License-Identifier: GPL-3.0-only45module Parser where67import Language.QBE.Parser (dataDef, funcDef, typeDef)8import Language.QBE.Types9import Test.Tasty10import Test.Tasty.HUnit11import qualified Text.ParserCombinators.Parsec as P1213typeTests :: TestTree14typeTests =15 testGroup16 "Aggregate Type Definition"17 [ testCase "Opaque type with alignment" $18 let v = TypeDef (UserIdent "opaque") (Just AlignLongLong) (AOpaque 32)19 in parse "type :opaque = align 16 { 32 }" @?= Right v,20 testCase "Regular empty type" $21 let v = TypeDef (UserIdent "empty") Nothing (ARegular [])22 in parse "type :empty = {}" @?= Right v,23 testCase "Regular type with multiple fields" $24 let f = [(SExtType (Base Single), Nothing), (SExtType (Base Single), Nothing)]25 v = TypeDef (UserIdent "twofloats") Nothing (ARegular f)26 in parse "type :twofloats = { s, s }" @?= Right v,27 testCase "Regular type with trailing whitespaces" $28 let f = [(SExtType Byte, Nothing), (SExtType (Base Word), Just 100)]29 v = TypeDef (UserIdent "abyteandmanywords") Nothing (ARegular f)30 in parse "type :abyteandmanywords = { b, w 100 }" @?= Right v,31 testCase "Union type with multiple fields" $32 let f = [[(SExtType Byte, Nothing)], [(SExtType (Base Single), Nothing)]]33 v = TypeDef (UserIdent "un9") Nothing (AUnion f)34 in parse "type :un9 = { { b } { s } }" @?= Right v,35 testCase "Union type with multiple nested fields" $36 let f =37 [ [(SExtType (Base Long), Nothing), (SExtType (Base Single), Nothing)],38 [(SExtType (Base Word), Nothing), (SExtType (Base Long), Nothing)]39 ]40 v = TypeDef (UserIdent "un9") Nothing (AUnion f)41 in parse "type :un9 = { { l, s } { w, l } }" @?= Right v42 ]43 where44 parse :: String -> Either P.ParseError TypeDef45 parse = P.parse typeDef ""4647dataTests :: TestTree48dataTests =49 testGroup50 "Data Definition"51 [ testCase "Data definition with zero fill" $52 let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]53 in parse "data $foo = { z 42 }" @?= Right v,54 testCase "Data definition with empty value" $55 let v = DataDef [] (GlobalIdent "foo") Nothing []56 in parse "data $foo = {}" @?= Right v,57 testCase "Data definition without optional spaces" $58 let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]59 in parse "data $foo={z 42}" @?= Right v,60 testCase "Data definition with newlines as spaces" $61 let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]62 in parse "data\n$foo={z\n42}" @?= Right v,63 testCase "Data definition with comments" $64 let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]65 in parse "data\n#test\n$foo={z\n#foo\n42}" @?= Right v,66 testCase "Data definition with comments and whitespaces" $67 let v = DataDef [] (GlobalIdent "foo") Nothing [OZeroFill 42]68 in parse "data\n#test1 \n #test2\n$foo={z\n#foo\n42}" @?= Right v,69 testCase "Data definition with linkage" $70 let v = DataDef [LExport] (GlobalIdent "foo") Nothing [OZeroFill 42]71 in parse "export data $foo = { z 42 }" @?= Right v,72 testCase "Data definition with linkage, newlines, and comments" $73 let v = DataDef [LExport, LThread] (GlobalIdent "foo") Nothing [OZeroFill 42]74 in parse "export\nthread\n#foo\ndata $foo = { z 42 }" @?= Right v,75 testCase "Data definition with types" $76 let w = [DConst (Number 23), DConst (Number 42)]77 v = DataDef [] (GlobalIdent "bar") Nothing [OItem (Base Word) w]78 in parse "data $bar = { w 23 42 }" @?= Right v,79 testCase "An object containing two 64-bit fields" $80 let o =81 [ OItem (Base Long) [DConst (Number 0xffffffffffffffff)],82 OItem (Base Long) [DConst (Number 23)]83 ]84 v = DataDef [] (GlobalIdent "c") Nothing o85 in parse "data $c = { l -1, l 23 }" @?= Right v,86 testCase "Data definition with specified alignment and linkage" $87 let v = DataDef [LExport] (GlobalIdent "b") (Just AlignLong) [OZeroFill 1000]88 in parse "export data $b = align 8 { z 1000 }" @?= Right v,89 testCase "Data definition with linkage section and string escape sequences" $90 let v = DataDef [LSection "f\\oo\\\"bar" Nothing] (GlobalIdent "b") (Just AlignLong) [OZeroFill 1]91 in parse "section \"f\\oo\\\"bar\" data $b =align 8 {z 1}" @?= Right v92 ]93 where94 parse :: String -> Either P.ParseError DataDef95 parse = P.parse dataDef ""9697funcTests :: TestTree98funcTests =99 testGroup100 "Function Definition"101 [ testCase "Minimal function definition" $102 let p = [Regular (ABase Word) (LocalIdent "argc")]103 b = [Block {label = BlockIdent "start", stmt = [], term = Return Nothing}]104 f = FuncDef [] (GlobalIdent "main") Nothing p b105 in parse "function $main(w %argc) {\n@start\nret\n}" @?= Right f,106 testCase "Function definition with load instruction" $107 let s = [Assign (LocalIdent "v") Word (Load (LBase Word) (VLocal $ LocalIdent "addr"))]108 b = [Block {label = BlockIdent "begin", stmt = s, term = Return Nothing}]109 f = FuncDef [] (GlobalIdent "main") Nothing [] b110 in parse "function $main() {\n@begin\n%v =w loadw %addr\nret\n}" @?= Right f,111 testCase "Function definition with linkage and return type" $112 let p = [Regular (ABase Long) (LocalIdent "v")]113 b = [Block {label = BlockIdent "start", stmt = [], term = Return Nothing}]114 f = FuncDef [LExport, LThread] (GlobalIdent "example") (Just (ABase Word)) p b115 in parse "export\nthread function w $example(l %v) {\n@start\nret\n}" @?= Right f,116 testCase "Function definition with section linkage" $117 let p = [Regular (ABase Long) (LocalIdent "v")]118 b = [Block {label = BlockIdent "start", stmt = [], term = Return Nothing}]119 f = FuncDef [LSection "foo" Nothing] (GlobalIdent "bla") (Just (ABase Word)) p b120 in parse "section \"foo\"\nfunction w $bla(l %v) {\n@start\nret\n}" @?= Right f,121 testCase "Function definition with subword return type" $122 let b = [Block {label = BlockIdent "here", stmt = [], term = Halt}]123 f = FuncDef [] (GlobalIdent "f") (Just (ASubWordType SignedHalf)) [] b124 in parse "function sh $f() {\n@here\nhlt\n}" @?= Right f,125 testCase "Function definition with comments" $126 let p = [Regular (ABase Long) (LocalIdent "v")]127 b = [Block {label = BlockIdent "start", stmt = [], term = Return Nothing}]128 f = FuncDef [LSection "foo" (Just "bar")] (GlobalIdent "bla") (Just (ABase Word)) p b129 in parse "section \"foo\" \"bar\"\n#test\nfunction w $bla(l %v) {\n#foo\n@start\n# bar \nret\n#bllubbb\n#bllaaa\n}" @?= Right f130 ]131 where132 parse :: String -> Either P.ParseError FuncDef133 parse = P.parse funcDef ""134135mkParser :: TestTree136mkParser =137 testGroup138 "Tests for the QBE parser"139 [typeTests, dataTests, funcTests]