Added test for Show type class (show function).

Matthewar · Sep 12, 2018 · 567baf1 · 567baf1
1 parent f2d9c0a
commit 567baf1
Showing 1 changed file with 15 additions and 1 deletion.
diff --git a/test/Spec/Parser/Types/Token.hs b/test/Spec/Parser/Types/Token.hs
@@ -61,7 +61,7 @@ validUpperStrings = QC.testProperty "Valid upper case strings" $
 abstractLiteralTests :: TestTree
 abstractLiteralTests = testGroup "Abstract literal class tests"
    [ abstractLiteralEqTests
-   --, abstractLiteralShowTests
+   , abstractLiteralShowTests
    ]
 
 -- |Tests for the derived 'Eq' type class for 'AbstractLiteral' type
@@ -83,6 +83,20 @@ abstractLiteralEqTests = testGroup "Eq type class tests"
             real <- QC.arbitrary
             QC.elements [(UniversalInteger int,UniversalReal real),(UniversalReal real,UniversalInteger int)]
 
+-- |Tests for the derived 'Show' type class for 'AbstractLiteral' type
+abstractLiteralShowTests :: TestTree
+abstractLiteralShowTests = QC.testProperty "Show type class test" $
+   QC.forAll genShowLiteral $ \(ExpectedOutput input expectedOutput) -> show input == expectedOutput
+   where genShowLiteral = convertShow <$> genLiteral
+         genLiteral = QC.oneof [ UniversalInteger <$> QC.arbitrary
+                               , UniversalReal <$> QC.arbitrary
+                               ]
+         convertShow lit@(UniversalInteger val) = ExpectedOutput lit $ "UniversalInteger " ++ showValue val
+         convertShow lit@(UniversalReal val) = ExpectedOutput lit $ "UniversalReal " ++ showValue val
+         showValue val
+            | val < 0 = "(" ++ show val ++ ")"
+            | otherwise = show val
+
 -- |Tests for constructor function of 'BitString'
 -- Uses constructor function 'mkBitString'
 bitStringTests :: TestTree