what4-1.7.1.0: test/PrinterTests.hs

{-# LANGUAGE DataKinds #-}

import Data.Parameterized (knownNat)
import Prettyprinter
import Test.Tasty
import Test.Tasty.HUnit
import What4.BaseTypes (FloatPrecisionRepr (FloatingPointPrecisionRepr), NatRepr, StringInfoRepr (Char16Repr, Char8Repr, UnicodeRepr))
import What4.InterpretedFloatingPoint (FloatInfoRepr (DoubleDoubleFloatRepr, DoubleFloatRepr, HalfFloatRepr, QuadFloatRepr, SingleFloatRepr, X86_80FloatRepr))

testPrettyPrint :: (Pretty a) => String -> a -> String -> TestTree
testPrettyPrint tcName obj expected =
  testCase tcName $
    let s = show $ pretty obj
     in assertEqual "Should be equal" expected s

testPrintHalfFloatRepr :: TestTree
testPrintHalfFloatRepr = testPrettyPrint "Print half repr" HalfFloatRepr "Half"

testPrintFloatInfoRepr :: TestTree
testPrintFloatInfoRepr = testPrettyPrint "Print single repr" SingleFloatRepr "Float"

testPrintDoubleInfoRepr :: TestTree
testPrintDoubleInfoRepr = testPrettyPrint "Print double repr" DoubleFloatRepr "Double"

testPrintQuadInfoRepr :: TestTree
testPrintQuadInfoRepr = testPrettyPrint "Print quad repr" QuadFloatRepr "Quad"

testPrintX86_80InfoRepr :: TestTree
testPrintX86_80InfoRepr = testPrettyPrint "Print X86_80 repr" X86_80FloatRepr "X86_80"

testPrintDoubleDoubleInfoRepr :: TestTree
testPrintDoubleDoubleInfoRepr = testPrettyPrint "Print double double repr" DoubleDoubleFloatRepr "DoubleDouble"

five :: NatRepr 5
five = knownNat

eleven :: NatRepr 11
eleven = knownNat

main :: IO ()
main =
  defaultMain $
    testGroup "printers" $
      [ testGroup "Float printers" $
          [ testPrintFloatInfoRepr,
            testPrintHalfFloatRepr,
            testPrintDoubleInfoRepr,
            testPrintQuadInfoRepr,
            testPrintX86_80InfoRepr,
            testPrintDoubleDoubleInfoRepr
          ],
        testGroup "String repr printers" $
          [ testPrettyPrint "Print unicode repr" UnicodeRepr "Unicode",
            testPrettyPrint "Print char16 repr" Char16Repr "Char16",
            testPrettyPrint "Print char8 repr" Char8Repr "Char8"
          ],
        testGroup "Float precision repr prints" $
          [ testPrettyPrint "Print float precision repr" (FloatingPointPrecisionRepr five eleven) "(FloatingPrecision 5 11)"
          ]
      ]