Francesco Gazzetta
56 lines
1.7 KiB
Haskell
56 lines
1.7 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE ExistentialQuantification #-}
|
|
module Main (main) where
|
|
|
|
import Language.QBE
|
|
|
|
import Test.Tasty (TestTree, defaultMain, testGroup)
|
|
import Test.Tasty.Silver (goldenVsAction)
|
|
import System.FilePath ((</>), (<.>))
|
|
import Prettyprinter (Pretty(pretty), layoutPretty, defaultLayoutOptions)
|
|
import Prettyprinter.Render.Text (renderStrict)
|
|
|
|
|
|
data P = forall a. Pretty a => P a
|
|
instance Pretty P where
|
|
pretty (P x) = pretty x
|
|
|
|
main :: IO ()
|
|
main = defaultMain goldenTests
|
|
|
|
goldenTests :: TestTree
|
|
goldenTests = testGroup "golden tests"
|
|
[ t "ident"
|
|
[ P $ Ident @'AggregateTy "aggregateTy"
|
|
, P $ Ident @'Global "global"
|
|
, P $ Ident @'Temporary "temporary"
|
|
, P $ Ident @'Label "label"
|
|
]
|
|
, t "type" ([Word, Long, Single, Double], [BaseTy Word, Byte, HalfWord])
|
|
, t "const"
|
|
[ CInt True 1
|
|
, CInt False 2
|
|
, CSingle 0.1
|
|
, CDouble (-0.2)
|
|
, CGlobal $ Ident "global"
|
|
]
|
|
, t "linkage" (Export, Section "secName" Nothing, Section "secName" $ Just "flag1 flag2")
|
|
, t "typedef" $ Typedef (Ident "t") (Just 8)
|
|
[ (SubExtTy HalfWord, Just 16)
|
|
, (SubAggregateTy (Ident "t1"), Nothing)
|
|
]
|
|
, t "opaque" $ Opaque (Ident "t") 8 16
|
|
, t "val" [ValConst (CInt False 0), ValTemporary $ Ident "temporary", ValGlobal $ Ident "global"]
|
|
, t "jmp" $ Jmp $ Ident "target"
|
|
, t "jnz" $ Jnz (ValConst $ CInt False 0) (Ident "target1") (Ident "target2")
|
|
, t "ret" $ Ret $ Just $ ValTemporary $ Ident "x"
|
|
]
|
|
where
|
|
t name value = goldenVsAction
|
|
name
|
|
("golden" </> name <.> "qbe")
|
|
(pure $ pretty value)
|
|
(renderStrict . layoutPretty defaultLayoutOptions)
|