X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FOctet.hs;h=affce396f79a403941c9e0dda7ff9dfa19151d99;hb=2fcbd5144dae4837b26638baa170ae97f3ee1ea2;hp=4664d1964c21eefcc9aaf0fb32452ab42fd9fd0e;hpb=a2afcdfec4ded920e133f28e069275caadc890c0;p=hath.git diff --git a/src/Octet.hs b/src/Octet.hs index 4664d19..affce39 100644 --- a/src/Octet.hs +++ b/src/Octet.hs @@ -7,15 +7,16 @@ where import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) import Test.Tasty.QuickCheck ( - Arbitrary(..), + Arbitrary( arbitrary ), Gen, Property, (==>), testProperty ) -import Bit as B (Bit(..)) -import Maskable (Maskable(..)) -import Maskbits (Maskbits(..)) +import Bit as B( Bit( Zero, One) ) +import Maskable( Maskable( apply_mask) ) +import Maskbits( + Maskbits( Zero, One, Two, Three, Four, Five, Six, Seven, Eight ) ) -- | An Octet consists of eight bits. For our purposes, the most -- significant bit will come "first." That is, b1 is in the 2^7 @@ -29,7 +30,7 @@ data Octet = b6 :: Bit, b7 :: Bit, b8 :: Bit } - deriving (Eq) + deriving (Eq, Ord) instance Show Octet where @@ -82,19 +83,6 @@ instance Maskable Octet where apply_mask oct _ _ = oct -instance Ord Octet where - (Octet x1 x2 x3 x4 x5 x6 x7 x8) <= (Octet y1 y2 y3 y4 y5 y6 y7 y8) - | x1 > y1 = False - | x2 > y2 = False - | x3 > y3 = False - | x4 > y4 = False - | x5 > y5 = False - | x6 > y6 = False - | x7 > y7 = False - | x8 > y8 = False - | otherwise = True - - instance Bounded Octet where -- | The octet with the least possible value. minBound = @@ -153,7 +141,7 @@ instance Read Octet where octet_tests :: TestTree octet_tests = testGroup "Octet Tests" [ - test_octet_from_int1, + test_octet_to_enum1, test_octet_mask1, test_octet_mask2 ] @@ -162,7 +150,8 @@ octet_properties = testGroup "Octet Properties " [ prop_from_enum_to_enum_inverses, - prop_read_show_inverses ] + prop_read_show_inverses, + prop_ord_instances_agree ] -- QuickCheck properties prop_from_enum_to_enum_inverses :: TestTree @@ -187,15 +176,29 @@ prop_read_show_inverses = x' :: Int x' = read $ show oct +-- | Ensure that the Ord instance for Octets agrees with the Ord +-- instance for Int (i.e. that numerical comparisons work). +prop_ord_instances_agree :: TestTree +prop_ord_instances_agree = + testProperty "the Octet and Int Ord instances agree" prop + where + prop :: Int -> Int -> Property + prop x y = (0 <= x) && (x <= 255) && (0 <= y) && (y <= 255) ==> ord == ord' + where + ord = (x <= y) + + oct1 = toEnum x :: Octet + oct2 = toEnum y :: Octet + ord' = (oct1 <= oct2) -- HUnit Tests -test_octet_from_int1 :: TestTree -test_octet_from_int1 = +test_octet_to_enum1 :: TestTree +test_octet_to_enum1 = testCase desc $ actual @?= expected where - desc = "octet_from_int 128 should parse as 10000000" + desc = "toEnum 128 should parse as 10000000" expected = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero - actual = toEnum 128 + actual = toEnum 128 :: Octet test_octet_mask1 :: TestTree @@ -204,7 +207,7 @@ test_octet_mask1 = where desc = "The network bits of 255/4 should equal 240" expected = toEnum 240 :: Octet - actual = apply_mask (toEnum 255) Four B.Zero + actual = apply_mask (toEnum 255) Four B.Zero :: Octet test_octet_mask2 :: TestTree @@ -213,4 +216,4 @@ test_octet_mask2 = where desc = "The network bits of 255/1 should equal 128" expected = toEnum 128 :: Octet - actual = apply_mask (toEnum 255) Maskbits.One B.Zero + actual = apply_mask (toEnum 255) Maskbits.One B.Zero :: Octet