diff options
author | Yann Herklotz Grave <git@yannherklotzgrave.com> | 2019-02-20 17:40:46 +0000 |
---|---|---|
committer | Yann Herklotz Grave <git@yannherklotzgrave.com> | 2019-02-20 17:40:46 +0000 |
commit | f9985ed4a104f8df2068336d4958dd4a2be0acb0 (patch) | |
tree | e61b6a62fc1c6a1eea5aa5e8980fff8e4903b516 /test | |
parent | 8f5147d0bf8fefff89d880288053b2d1b13de849 (diff) | |
download | pfm-f9985ed4a104f8df2068336d4958dd4a2be0acb0.tar.gz pfm-f9985ed4a104f8df2068336d4958dd4a2be0acb0.zip |
Add broken idempotent test
Diffstat (limited to 'test')
-rw-r--r-- | test/Test.hs | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 index 0000000..63b846c --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,49 @@ +module Main where + +import qualified Data.ByteString.Lazy as BL +import PFM +import Test.Tasty +import Test.Tasty.QuickCheck ((===)) +import qualified Test.Tasty.QuickCheck as QC + +newtype TestPFMImage = TestPFMImage { getPFMImage :: PFMImage } + deriving (Show) + +newtype TestPFMColour = TestPFMColour { getPFMColour :: PFMColour } + deriving (Show) + +newtype TestPPMImage = TestPPMImage { getPPMImage :: PPMImage } + deriving (Show) + +newtype TestPPMColour = TestPPMColour { getPPMColour :: PPMColour } + deriving (Show) + +instance QC.Arbitrary TestPFMImage where + arbitrary = TestPFMImage <$> (PFMImage <$> QC.arbitrary <*> QC.arbitrary + <*> (QC.listOf1 . QC.listOf1) (getPFMColour <$> QC.arbitrary)) + +instance QC.Arbitrary TestPPMImage where + arbitrary = TestPPMImage <$> (PPMImage <$> QC.arbitrary <*> QC.arbitrary + <*> (QC.listOf1 . QC.listOf1) (getPPMColour <$> QC.arbitrary)) + +instance QC.Arbitrary TestPFMColour where + arbitrary = TestPFMColour <$> (PFMColour <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary) + +instance QC.Arbitrary TestPPMColour where + arbitrary = TestPPMColour <$> (PPMColour <$> QC.arbitrary <*> QC.arbitrary <*> QC.arbitrary) + +parserIdempotent' :: TestPFMImage -> QC.Property +parserIdempotent' (TestPFMImage v) = p i === (p . p) i + where + encStrict = BL.toStrict . encode + i = encStrict v + p = encStrict . parse + +parserIdempotent :: TestTree +parserIdempotent = QC.testProperty "parser idempotent" parserIdempotent' + +tests :: TestTree +tests = testGroup "Property" [parserIdempotent] + +main :: IO () +main = defaultMain tests |