X-Git-Url: http://gitweb.michael.orlitzky.com/?p=hath.git;a=blobdiff_plain;f=src%2FCidr.hs;h=af9c9e8ba55a6c9aaaa5190baf4800599a1623cc;hp=d7f624654743f24f6c3ac4a85939c56159e69e1d;hb=a8c2d85d8611f7f56eaa0c3406ec423d68f81f96;hpb=6087bef9274022251014f4ecbd166c35710480cd diff --git a/src/Cidr.hs b/src/Cidr.hs index d7f6246..af9c9e8 100644 --- a/src/Cidr.hs +++ b/src/Cidr.hs @@ -23,12 +23,13 @@ import Data.List (nub) import Data.List.Split (splitOneOf) import Data.Maybe (catMaybes, mapMaybe) -import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty ( TestTree, localOption, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Test.Tasty.QuickCheck ( Arbitrary( arbitrary ), Gen, Property, + QuickCheckTests( QuickCheckTests ), (==>), testProperty ) import Text.Read (readMaybe) @@ -304,6 +305,7 @@ cidr_properties = prop_contains_proper_antisymmetric, prop_normalize_idempotent, prop_normalize_preserves_equality, + prop_ord_instance_antisymmetric, prop_ord_instance_reflexive, prop_ord_instance_transitive ] @@ -563,6 +565,7 @@ prop_normalize_preserves_equality = prop :: Cidr -> Cidr -> Bool prop cidr1 cidr2 = (cidr1 == cidr2) == (normalize cidr1 == normalize cidr2) + prop_ord_instance_reflexive :: TestTree prop_ord_instance_reflexive = testProperty "The CIDR order is reflexive" prop @@ -578,3 +581,15 @@ prop_ord_instance_transitive = prop :: Cidr -> Cidr -> Cidr -> Property prop cidr1 cidr2 cidr3 = (cidr1 <= cidr2 && cidr2 <= cidr3) ==> cidr1 <= cidr3 + +-- This is how Eq is currently implemented, but it is useful to have +-- around in case that changes. Try fewer instances of this than usual +-- because it's a rare condition. +prop_ord_instance_antisymmetric :: TestTree +prop_ord_instance_antisymmetric = + localOption (QuickCheckTests 500) $ + testProperty "The CIDR order is antisymmetric" prop + where + prop :: Cidr -> Cidr -> Property + prop cidr1 cidr2 = + (cidr1 <= cidr2 && cidr2 <= cidr1) ==> cidr1 == cidr2