qute - Expression.hs

  1-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
  2--
  3-- SPDX-License-Identifier: GPL-3.0-only
  4
  5module Expression (exprTests) where
  6
  7import Data.Int (Int64)
  8import Data.Maybe (fromJust)
  9import Language.QBE.Simulator.Default.Expression qualified as DE
 10import Language.QBE.Simulator.Expression qualified as E
 11import Language.QBE.Types qualified as Q
 12import Test.Tasty
 13import Test.Tasty.HUnit
 14
 15exprTests :: TestTree
 16exprTests =
 17  testGroup
 18    "Expression Tests"
 19    [ testCase "Test equality" $
 20        do
 21          let lhs = E.fromLit (Q.Base Q.Word) 23 :: DE.RegVal
 22          let rhs = E.fromLit (Q.Base Q.Word) 42 :: DE.RegVal
 23
 24          lhs `E.eq` lhs @?= truthValue
 25          lhs `E.ne` lhs @?= falseValue
 26
 27          lhs `E.eq` rhs @?= falseValue
 28          lhs `E.ne` rhs @?= truthValue,
 29      testCase "Test unsigned comparison" $
 30        do
 31          let lhs = E.fromLit (Q.Base Q.Word) 23 :: DE.RegVal
 32          let rhs = E.fromLit (Q.Base Q.Word) 42 :: DE.RegVal
 33
 34          lhs `E.ule` rhs @?= truthValue
 35          lhs `E.ule` lhs @?= truthValue
 36          lhs `E.ult` lhs @?= falseValue,
 37      testCase "Test signed comparision" $
 38        do
 39          let lhs = E.fromLit (Q.Base Q.Word) (fromIntegral (-1 :: Int64)) :: DE.RegVal
 40          let rhs = E.fromLit (Q.Base Q.Word) 0 :: DE.RegVal
 41
 42          lhs `E.slt` rhs @?= truthValue
 43          lhs `E.sle` lhs @?= truthValue
 44          lhs `E.ult` rhs @?= falseValue,
 45      testCase "sar preserves sign bit" $
 46        do
 47          let v = E.fromLit (Q.Base Q.Word) (fromIntegral (-256 :: Int64)) :: DE.RegVal
 48          let r = fromJust $ v `E.sar` E.fromLit (Q.Base Q.Word) 1
 49          r @?= E.fromLit (Q.Base Q.Word) (fromIntegral (-128 :: Int64)),
 50      testCase "shr does not preserve sign bit" $
 51        do
 52          let v = E.fromLit (Q.Base Q.Word) (fromIntegral (-0x80000000 :: Int64)) :: DE.RegVal
 53          let r = fromJust $ v `E.shr` E.fromLit (Q.Base Q.Word) 8
 54          r @?= E.fromLit (Q.Base Q.Word) 0x800000,
 55      testCase "extend byte to word" $
 56        do
 57          let v = E.fromLit Q.Byte 128 :: DE.RegVal
 58
 59          let signExt = E.fromLit (Q.Base Q.Word) 0xffffff80 :: DE.RegVal
 60          E.extend (Q.Base Q.Word) True v @?= Just signExt
 61
 62          let zeroExt = E.fromLit (Q.Base Q.Word) 128 :: DE.RegVal
 63          E.extend (Q.Base Q.Word) False v @?= Just zeroExt,
 64      testCase "extend float" $
 65        do
 66          let s = E.fromLit (Q.Base Q.Single) 2342 :: DE.RegVal
 67          E.extend (Q.Base Q.Long) False s @?= Nothing
 68
 69          let d = E.fromLit (Q.Base Q.Double) 2342 :: DE.RegVal
 70          E.extend (Q.Base Q.Long) False d @?= Nothing,
 71      testCase "current size exceeds extend" $
 72        do
 73          let s = E.fromLit (Q.Base Q.Word) 2342 :: DE.RegVal
 74          E.extend Q.Byte False s @?= Nothing,
 75      testCase "current size equals extend" $
 76        do
 77          let s = E.fromLit (Q.Base Q.Word) 2342 :: DE.RegVal
 78          E.extend (Q.Base Q.Word) True s @?= Nothing,
 79      testCase "extract from word" $
 80        do
 81          let v = E.fromLit (Q.Base Q.Word) 0xdeadbeef :: DE.RegVal
 82
 83          let e1 = E.fromLit Q.Byte 0xef :: DE.RegVal
 84          E.extract Q.Byte v @?= Just e1
 85
 86          let e2 = E.fromLit Q.HalfWord 0xbeef :: DE.RegVal
 87          E.extract Q.HalfWord v @?= Just e2,
 88      testCase "extract from float" $
 89        do
 90          let d = E.fromLit (Q.Base Q.Double) 2342 :: DE.RegVal
 91          E.extract Q.Byte d @?= Nothing
 92          E.extract (Q.Base Q.Single) d @?= Nothing
 93
 94          let s = E.fromLit (Q.Base Q.Single) 2342 :: DE.RegVal
 95          E.extract Q.Byte s @?= Nothing
 96          E.extract (Q.Base Q.Single) s @?= Nothing,
 97      testCase "extract exceeds size" $
 98        do
 99          let v = E.fromLit (Q.Base Q.Word) 0xdeadbeef :: DE.RegVal
100          E.extract (Q.Base Q.Long) v @?= Nothing
101    ]
102  where
103    falseValue = Just (E.fromLit (Q.Base Q.Long) 0 :: DE.RegVal)
104    truthValue = Just (E.fromLit (Q.Base Q.Long) 1 :: DE.RegVal)