From eee156f562f9c1c1194a67cef12f146304d88ce9 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Mon, 12 May 2014 04:13:31 -0400 Subject: [PATCH] Switch from test-framework to tasty. Bump version to 0.1.3. --- hath.cabal | 47 +++++----- src/Bit.hs | 5 +- src/Cidr.hs | 221 +++++++++++++++++++-------------------------- src/IPv4Address.hs | 72 ++++++++------- src/Main.hs | 3 + src/Maskbits.hs | 5 +- src/Octet.hs | 87 +++++++++--------- test/TestSuite.hs | 48 +++------- 8 files changed, 219 insertions(+), 269 deletions(-) diff --git a/hath.cabal b/hath.cabal index 1bdc6d6..9f2d972 100644 --- a/hath.cabal +++ b/hath.cabal @@ -1,5 +1,5 @@ name: hath -version: 0.1.2 +version: 0.1.3 cabal-version: >= 1.8 author: Michael Orlitzky maintainer: Michael Orlitzky @@ -138,15 +138,14 @@ executable hath base >= 4.6 && < 4.7, bytestring == 0.10.*, cmdargs == 0.10.*, - dns == 1.*, - HUnit == 1.2.*, - QuickCheck == 2.6.*, + dns >= 1.2, MissingH == 1.2.*, parallel-io == 0.3.*, + QuickCheck == 2.7.*, split == 0.2.*, - test-framework == 0.8.*, - test-framework-hunit == 0.3.*, - test-framework-quickcheck2 == 0.3.* + tasty == 0.8.*, + tasty-hunit == 0.8.*, + tasty-quickcheck == 0.8.* ghc-options: -Wall @@ -180,15 +179,15 @@ test-suite testsuite base >= 4.6 && < 4.7, bytestring == 0.10.*, cmdargs == 0.10.*, - dns == 1.*, - HUnit == 1.2.*, - QuickCheck == 2.6.*, + dns >= 1.2, MissingH == 1.2.*, parallel-io == 0.3.*, + QuickCheck == 2.7.*, split == 0.2.*, - test-framework == 0.8.*, - test-framework-hunit == 0.3.*, - test-framework-quickcheck2 == 0.3.* + tasty == 0.8.*, + tasty-hunit == 0.8.*, + tasty-quickcheck == 0.8.* + -- It's not entirely clear to me why I have to reproduce all of this. ghc-options: @@ -220,16 +219,15 @@ test-suite shelltests base >= 4.6 && < 4.7, bytestring == 0.10.*, cmdargs == 0.10.*, - dns == 1.*, - HUnit == 1.2.*, - QuickCheck == 2.6.*, + dns >= 1.2, MissingH == 1.2.*, parallel-io == 0.3.*, process == 1.1.*, + QuickCheck == 2.7.*, split == 0.2.*, - test-framework == 0.8.*, - test-framework-hunit == 0.3.*, - test-framework-quickcheck2 == 0.3.* + tasty == 0.8.*, + tasty-hunit == 0.8.*, + tasty-quickcheck == 0.8.* -- It's not entirely clear to me why I have to reproduce all of this. ghc-options: @@ -259,16 +257,15 @@ test-suite shelltests-net base >= 4.6 && < 4.7, bytestring == 0.10.*, cmdargs == 0.10.*, - dns == 1.*, - HUnit == 1.2.*, - QuickCheck == 2.6.*, + dns >= 1.2, MissingH == 1.2.*, parallel-io == 0.3.*, process == 1.1.*, + QuickCheck == 2.7.*, split == 0.2.*, - test-framework == 0.8.*, - test-framework-hunit == 0.3.*, - test-framework-quickcheck2 == 0.3.* + tasty == 0.8.*, + tasty-hunit == 0.8.*, + tasty-quickcheck == 0.8.* -- It's not entirely clear to me why I have to reproduce all of this. ghc-options: diff --git a/src/Bit.hs b/src/Bit.hs index c01ae94..0f02fbf 100644 --- a/src/Bit.hs +++ b/src/Bit.hs @@ -5,11 +5,10 @@ module Bit ( ) where -import Test.QuickCheck ( +import Test.Tasty.QuickCheck ( Arbitrary, arbitrary, - elements - ) + elements ) data Bit = Zero | One diff --git a/src/Cidr.hs b/src/Cidr.hs index 368cf76..6e75966 100644 --- a/src/Cidr.hs +++ b/src/Cidr.hs @@ -16,19 +16,20 @@ module Cidr min_octet2, min_octet3, min_octet4, - prop_all_cidrs_contain_themselves, - prop_contains_proper_intransitive ) where import Data.List (nubBy) import Data.List.Split (splitOneOf) import Data.Maybe (catMaybes, mapMaybe) -import Test.HUnit (assertEqual) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>)) +import Test.QuickCheck ( Gen ) -- Not re-exported by tasty +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( (@?=), testCase ) +import Test.Tasty.QuickCheck ( + Arbitrary(..), + Property, + (==>), + testProperty ) import Text.Read (readMaybe) import qualified Bit as B (Bit(..)) @@ -259,7 +260,7 @@ enumerate :: Cidr -> [IPv4Address] enumerate cidr = [(min_host cidr)..(max_host cidr)] -- Test lists. -cidr_tests :: Test +cidr_tests :: TestTree cidr_tests = testGroup "CIDR Tests" [ test_enumerate, @@ -280,23 +281,17 @@ cidr_tests = test_combine_all2, test_combine_all3 ] -cidr_properties :: Test +cidr_properties :: TestTree cidr_properties = testGroup "CIDR Properties" [ - testProperty - "All CIDRs contain themselves" prop_all_cidrs_contain_themselves, - - testProperty - "contains_proper is intransitive" - prop_contains_proper_intransitive - ] + prop_contains_proper_antisymmetric ] -- HUnit Tests -test_enumerate :: Test +test_enumerate :: TestTree test_enumerate = - testCase desc $ assertEqual desc expected actual + testCase desc $ actual @?= expected where desc = "192.168.0.240/30 is enumerated correctly" oct1 = toEnum 192 @@ -310,180 +305,144 @@ test_enumerate = expected = [addr1, addr2, addr3, addr4] actual = enumerate $ read "192.168.0.240/30" -test_min_host1 :: Test +test_min_host1 :: TestTree test_min_host1 = - testCase desc $ - assertEqual desc - expected - actual + testCase desc $ actual @?= expected where desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0" actual = show $ min_host (read "10.0.0.0/24") expected = "10.0.0.0" -test_max_host1 :: Test +test_max_host1 :: TestTree test_max_host1 = - testCase desc $ - assertEqual desc - expected - actual + testCase desc $ actual @?= expected where desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255" actual = show $ max_host (read "10.0.0.0/24") expected = "10.0.0.255" -test_equality1 :: Test +test_equality1 :: TestTree test_equality1 = - testCase desc $ - assertEqual - desc - True - (cidr1 == cidr1) + testCase desc $ actual @?= expected where desc = "10.1.1.0/23 equals itself" - cidr1 = read "10.1.1.0/23" :: Cidr + actual = read "10.1.1.0/23" :: Cidr + expected = read "10.1.1.0/23" :: Cidr -test_contains1 :: Test +test_contains1 :: TestTree test_contains1 = - testCase desc $ - assertEqual - desc - True - (cidr1 `contains` cidr2) + testCase desc $ actual @?= expected where desc = "10.1.1.0/23 contains 10.1.1.0/24" cidr1 = read "10.1.1.0/23" cidr2 = read "10.1.1.0/24" + expected = True + actual = cidr1 `contains` cidr2 -test_contains2 :: Test +test_contains2 :: TestTree test_contains2 = - testCase desc $ - assertEqual - desc - True - (cidr1 `contains` cidr1) + testCase desc $ actual @?= expected where desc = "10.1.1.0/23 contains itself" cidr1 = read "10.1.1.0/23" + expected = True + actual = cidr1 `contains` cidr1 -test_contains_proper1 :: Test +test_contains_proper1 :: TestTree test_contains_proper1 = - testCase desc $ - assertEqual - desc - True - (cidr1 `contains_proper` cidr2) + testCase desc $ actual @?= expected where desc = "10.1.1.0/23 contains 10.1.1.0/24 properly" cidr1 = read "10.1.1.0/23" cidr2 = read "10.1.1.0/24" + expected = True + actual = cidr1 `contains_proper` cidr2 -test_contains_proper2 :: Test +test_contains_proper2 :: TestTree test_contains_proper2 = - testCase desc $ - assertEqual - desc - False - (cidr1 `contains_proper` cidr1) + testCase desc $ actual @?= expected where desc = "10.1.1.0/23 does not contain itself properly" cidr1 = read "10.1.1.0/23" + expected = False + actual = cidr1 `contains_proper` cidr1 -test_adjacent1 :: Test +test_adjacent1 :: TestTree test_adjacent1 = - testCase desc $ - assertEqual - desc - True - (cidr1 `adjacent` cidr2) + testCase desc $ actual @?= expected where desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24" cidr1 = read "10.1.0.0/24" cidr2 = read "10.1.1.0/24" + expected = True + actual = cidr1 `adjacent` cidr2 -test_adjacent2 :: Test +test_adjacent2 :: TestTree test_adjacent2 = - testCase desc $ - assertEqual - desc - False - (cidr1 `adjacent` cidr2) + testCase desc $ actual @?= expected where desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24" cidr1 = read "10.1.0.0/23" cidr2 = read "10.1.0.0/24" + expected = False + actual = cidr1 `adjacent` cidr2 -test_adjacent3 :: Test +test_adjacent3 :: TestTree test_adjacent3 = - testCase desc $ - assertEqual - desc - False - (cidr1 `adjacent` cidr2) + testCase desc $ actual @?= expected where desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24" cidr1 = read "10.1.0.0/24" cidr2 = read "10.2.5.0/24" + expected = False + actual = cidr1 `adjacent` cidr2 -test_adjacent4 :: Test +test_adjacent4 :: TestTree test_adjacent4 = - testCase desc $ - assertEqual - desc - False - (cidr1 `adjacent` cidr2) + testCase desc $ actual @?= expected where desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24" cidr1 = read "10.1.1.0/24" cidr2 = read "10.1.2.0/24" + expected = False + actual = cidr1 `adjacent` cidr2 - -test_combine_contained1 :: Test +test_combine_contained1 :: TestTree test_combine_contained1 = - testCase desc $ - assertEqual - desc - expected_cidrs - (combine_contained test_cidrs) + testCase desc $ actual @?= expected where desc = "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8" cidr1 = read "10.0.0.0/8" cidr2 = read "10.1.0.0/16" cidr3 = read "10.1.1.0/24" - expected_cidrs = [cidr1] test_cidrs = [cidr1, cidr2, cidr3] + expected = [cidr1] + actual = combine_contained test_cidrs - -test_combine_contained2 :: Test +test_combine_contained2 :: TestTree test_combine_contained2 = - testCase desc $ - assertEqual - desc - [cidr1, cidr2] - (combine_contained [cidr1, cidr2]) + testCase desc $ actual @?= expected where desc = "192.168.3.0/23 does not contain 192.168.1.0/24" cidr1 = read "192.168.3.0/23" cidr2 = read "192.168.1.0/24" + expected = [cidr1, cidr2] + actual = combine_contained [cidr1, cidr2] -test_combine_all1 :: Test +test_combine_all1 :: TestTree test_combine_all1 = - testCase desc $ - assertEqual - desc - expected_cidrs - (combine_all test_cidrs) + testCase desc $ actual @?= expected where desc = "10.0.0.0/24 is adjacent to 10.0.1.0/24 " ++ "and 10.0.3.0/23 contains 10.0.2.0/24" @@ -492,31 +451,25 @@ test_combine_all1 = cidr3 = read "10.0.2.0/24" cidr4 = read "10.0.3.0/23" cidr5 = read "10.0.0.0/23" - expected_cidrs = [read "10.0.0.0/22"] test_cidrs = [cidr1, cidr2, cidr3, cidr4, cidr5] + expected = [read "10.0.0.0/22"] + actual = combine_all test_cidrs -test_combine_all2 :: Test +test_combine_all2 :: TestTree test_combine_all2 = - testCase desc $ - assertEqual - desc - expected_cidrs - (combine_all test_cidrs) - where - desc = "127.0.0.1/32 combines with itself recursively" - cidr1 = read "127.0.0.1/32" - expected_cidrs = [cidr1] - test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1] + testCase desc $ actual @?= expected + where + desc = "127.0.0.1/32 combines with itself recursively" + cidr1 = read "127.0.0.1/32" + test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1] + expected = [cidr1] + actual = combine_all test_cidrs -test_combine_all3 :: Test +test_combine_all3 :: TestTree test_combine_all3 = - testCase desc $ - assertEqual - desc - expected_cidrs - (combine_all test_cidrs) + testCase desc $ actual @?= expected where desc = "10.0.0.16, 10.0.0.17, 10.0.0.18, and " ++ "10.0.0.19 get combined into 10.0.0.16/30" @@ -524,18 +477,26 @@ test_combine_all3 = cidr2 = read "10.0.0.17/32" cidr3 = read "10.0.0.18/32" cidr4 = read "10.0.0.19/32" - expected_cidrs = [read "10.0.0.16/30"] test_cidrs = [cidr1, cidr2, cidr3, cidr4] - + expected = [read "10.0.0.16/30"] + actual = combine_all test_cidrs -- QuickCheck Tests -prop_all_cidrs_contain_themselves :: Cidr -> Bool -prop_all_cidrs_contain_themselves cidr1 = cidr1 `contains` cidr1 +prop_all_cidrs_contain_themselves :: TestTree +prop_all_cidrs_contain_themselves = + testProperty "All CIDRs contain themselves" prop + where + prop :: Cidr -> Bool + prop cidr1 = cidr1 `contains` cidr1 -- If cidr1 properly contains cidr2, then by definition cidr2 -- does not properly contain cidr1. -prop_contains_proper_intransitive :: Cidr -> Cidr -> Property -prop_contains_proper_intransitive cidr1 cidr2 = - (cidr1 `contains_proper` cidr2) ==> - (not (cidr2 `contains_proper` cidr1)) +prop_contains_proper_antisymmetric :: TestTree +prop_contains_proper_antisymmetric = + testProperty "CIDR proper containment is an antisymmetric relation" prop + where + prop :: Cidr -> Cidr -> Property + prop cidr1 cidr2 = + (cidr1 `contains_proper` cidr2) ==> + (not (cidr2 `contains_proper` cidr1)) diff --git a/src/IPv4Address.hs b/src/IPv4Address.hs index f4bfc97..d262a5c 100644 --- a/src/IPv4Address.hs +++ b/src/IPv4Address.hs @@ -5,11 +5,15 @@ module IPv4Address( most_sig_bit_different ) where -import Test.HUnit (assertEqual) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>)) + +import Test.QuickCheck ( Gen ) -- Not re-exported by tasty +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( (@?=), testCase ) +import Test.Tasty.QuickCheck ( + Arbitrary(..), + Property, + (==>), + testProperty ) import Maskable (Maskable(..)) import Maskbits (Maskbits(..)) @@ -323,7 +327,7 @@ most_sig_bit_different addr1 addr2 -- Test lists. -ipv4address_tests :: Test +ipv4address_tests :: TestTree ipv4address_tests = testGroup "IPv4 Address Tests" [ test_enum, @@ -333,19 +337,21 @@ ipv4address_tests = test_most_sig_bit_different2, test_to_enum ] -ipv4address_properties :: Test +ipv4address_properties :: TestTree ipv4address_properties = testGroup "IPv4 Address Properties " - [ testProperty - "fromEnum/toEnum are inverses" - prop_from_enum_to_enum_inverses ] + [ prop_from_enum_to_enum_inverses ] -- QuickCheck properties -prop_from_enum_to_enum_inverses :: Int -> Property -prop_from_enum_to_enum_inverses x = - (0 <= x) && (x <= 2^(32 :: Integer) - 1) ==> - fromEnum (toEnum x :: IPv4Address) == x +prop_from_enum_to_enum_inverses :: TestTree +prop_from_enum_to_enum_inverses = + testProperty "fromEnum and toEnum are inverses" prop + where + prop :: Int -> Property + prop x = + (0 <= x) && (x <= 2^(32 :: Integer) - 1) ==> + fromEnum (toEnum x :: IPv4Address) == x -- HUnit Tests mk_testaddr :: Int -> Int -> Int -> Int -> IPv4Address @@ -357,25 +363,28 @@ mk_testaddr a b c d = oct3 = toEnum c oct4 = toEnum d -test_minBound :: Test + +test_minBound :: TestTree test_minBound = - testCase desc $ assertEqual desc expected actual + testCase desc $ actual @?= expected where desc = "minBound should be 0.0.0.0" expected = mk_testaddr 0 0 0 0 actual = minBound :: IPv4Address -test_maxBound :: Test + +test_maxBound :: TestTree test_maxBound = - testCase desc $ assertEqual desc expected actual + testCase desc $ actual @?= expected where desc = "maxBound should be 255.255.255.255" expected = mk_testaddr 255 255 255 255 actual = maxBound :: IPv4Address -test_enum :: Test + +test_enum :: TestTree test_enum = - testCase desc $ assertEqual desc expected actual + testCase desc $ actual @?= expected where desc = "enumerating a /24 gives the correct addresses" expected = ["192.168.0." ++ (show x) | x <- [0..255::Int] ] @@ -383,34 +392,33 @@ test_enum = ub = mk_testaddr 192 168 0 255 actual = map show [lb..ub] -test_most_sig_bit_different1 :: Test + +test_most_sig_bit_different1 :: TestTree test_most_sig_bit_different1 = - testCase desc $ assertEqual desc - TwentyFour - bit + testCase desc $ actual @?= expected where desc = "10.1.1.0 and 10.1.0.0 differ in bit 24" addr1 = mk_testaddr 10 1 1 0 addr2 = (mk_testaddr 10 1 0 0) - bit = most_sig_bit_different addr1 addr2 + expected = TwentyFour + actual = most_sig_bit_different addr1 addr2 -test_most_sig_bit_different2 :: Test +test_most_sig_bit_different2 :: TestTree test_most_sig_bit_different2 = - testCase desc $ assertEqual desc - TwentyThree - bit + testCase desc $ actual @?= expected where desc = "10.1.2.0 and 10.1.1.0 differ in bit 23" addr1 = mk_testaddr 10 1 2 0 addr2 = mk_testaddr 10 1 1 0 - bit = most_sig_bit_different addr1 addr2 + expected = TwentyThree + actual = most_sig_bit_different addr1 addr2 -test_to_enum :: Test +test_to_enum :: TestTree test_to_enum = - testCase desc $ assertEqual desc expected actual + testCase desc $ actual @?= expected where desc = "192.168.0.0 in base-10 is 3232235520" expected = mk_testaddr 192 168 0 0 diff --git a/src/Main.hs b/src/Main.hs index deb9022..2bb5869 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -7,6 +7,7 @@ import qualified Data.ByteString.Char8 as BS (intercalate, pack, unpack) import Data.List ((\\), intercalate) import Data.Maybe (catMaybes, isNothing) import Data.String.Utils (splitWs) +import Network.DNS.Types ( DNSError (NameError) ) import System.Exit (ExitCode(..), exitWith) import System.IO (stderr, hPutStrLn) import Text.Read (readMaybe) @@ -159,5 +160,7 @@ main = do space = BS.pack " " results = case eds of + -- NameError simply means "not found" so we output nothing. + Left NameError -> "" Left err -> "ERROR (" ++ (show err) ++ ")" Right ds -> BS.unpack $ BS.intercalate space ds diff --git a/src/Maskbits.hs b/src/Maskbits.hs index 5eb7649..27fa29f 100644 --- a/src/Maskbits.hs +++ b/src/Maskbits.hs @@ -1,9 +1,8 @@ module Maskbits( - Maskbits(..), - ) + Maskbits(..) ) where -import Test.QuickCheck (Arbitrary(..), elements) +import Test.Tasty.QuickCheck ( Arbitrary(..), elements ) -- | A type representing the number of bits in a CIDR netmask. diff --git a/src/Octet.hs b/src/Octet.hs index 6d6c8c8..55f075e 100644 --- a/src/Octet.hs +++ b/src/Octet.hs @@ -1,15 +1,17 @@ module Octet ( Octet(..), octet_properties, - octet_tests, - ) + octet_tests ) where -import Test.HUnit (assertEqual) -import Test.Framework (Test, testGroup) -import Test.Framework.Providers.HUnit (testCase) -import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Arbitrary(..), Gen, Property, (==>)) +import Test.QuickCheck ( Gen ) -- Not re-exported by tasty +import Test.Tasty ( TestTree, testGroup ) +import Test.Tasty.HUnit ( (@?=), testCase ) +import Test.Tasty.QuickCheck ( + Arbitrary(..), + Property, + (==>), + testProperty ) import Bit as B (Bit(..)) import Maskable (Maskable(..)) @@ -148,64 +150,67 @@ instance Read Octet where -- Test lists. -octet_tests :: Test +octet_tests :: TestTree octet_tests = testGroup "Octet Tests" [ test_octet_from_int1, test_octet_mask1, test_octet_mask2 ] -octet_properties :: Test +octet_properties :: TestTree octet_properties = testGroup "Octet Properties " - [ testProperty - "fromEnum/toEnum are inverses" - prop_from_enum_to_enum_inverses, - testProperty - "read/show are inverses" - prop_read_show_inverses ] + [ prop_from_enum_to_enum_inverses, + prop_read_show_inverses ] -- QuickCheck properties -prop_from_enum_to_enum_inverses :: Int -> Property -prop_from_enum_to_enum_inverses x = - (0 <= x) && (x <= 255) ==> - fromEnum (toEnum x :: Octet) == x - -prop_read_show_inverses :: Int -> Property -prop_read_show_inverses x = - (0 <= x) && (x <= 255) ==> x' == x +prop_from_enum_to_enum_inverses :: TestTree +prop_from_enum_to_enum_inverses = + testProperty "fromEnum and toEnum are inverses" prop where - oct :: Octet - oct = read $ show x + prop :: Int -> Property + prop x = + (0 <= x) && (x <= 255) ==> + fromEnum (toEnum x :: Octet) == x + +prop_read_show_inverses :: TestTree +prop_read_show_inverses = + testProperty "read and show are inverses" prop + where + prop :: Int -> Property + prop x = (0 <= x) && (x <= 255) ==> x' == x + where + oct :: Octet + oct = read $ show x + + x' :: Int + x' = read $ show oct - x' :: Int - x' = read $ show oct -- HUnit Tests -test_octet_from_int1 :: Test +test_octet_from_int1 :: TestTree test_octet_from_int1 = - testCase desc $ assertEqual desc oct1 oct2 + testCase desc $ actual @?= expected where desc = "octet_from_int 128 should parse as 10000000" - oct1 = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero - oct2 = toEnum 128 + expected = Octet B.One B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero B.Zero + actual = toEnum 128 + -test_octet_mask1 :: Test +test_octet_mask1 :: TestTree test_octet_mask1 = - testCase desc $ - assertEqual desc oct2 (apply_mask oct1 Four B.Zero) + testCase desc $ actual @?= expected where desc = "The network bits of 255/4 should equal 240" - oct1 = toEnum 255 - oct2 = toEnum 240 :: Octet + expected = toEnum 240 :: Octet + actual = apply_mask (toEnum 255) Four B.Zero -test_octet_mask2 :: Test +test_octet_mask2 :: TestTree test_octet_mask2 = - testCase desc $ - assertEqual desc oct2 (apply_mask oct1 Maskbits.One B.Zero) + testCase desc $ actual @?= expected where desc = "The network bits of 255/1 should equal 128" - oct1 = toEnum 255 - oct2 = toEnum 128 :: Octet + expected = toEnum 128 :: Octet + actual = apply_mask (toEnum 255) Maskbits.One B.Zero diff --git a/test/TestSuite.hs b/test/TestSuite.hs index 172bcfc..7cd8d93 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -1,43 +1,21 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} -import Data.Monoid (mempty) -import Test.Framework ( - Test, - defaultMainWithOpts ) -import Test.Framework.Options -import Test.Framework.Runners.Options +import Test.Tasty ( TestTree, defaultMain, localOption, testGroup ) +import Test.Tasty.QuickCheck ( QuickCheckTests(..), QuickCheckMaxRatio(..) ) +import Cidr ( cidr_properties, cidr_tests ) +import IPv4Address ( ipv4address_properties, ipv4address_tests ) +import Octet ( octet_properties, octet_tests ) -import Cidr ( - cidr_properties, - cidr_tests ) -import IPv4Address ( - ipv4address_properties, - ipv4address_tests ) -import Octet ( - octet_properties, - octet_tests ) - -tests :: [Test.Framework.Test] -tests = [ cidr_properties, +tests :: TestTree +tests = testGroup "All Tests" [ + cidr_properties, cidr_tests, ipv4address_properties, ipv4address_tests, octet_properties, octet_tests ] +-- TODO: Run 5000 generated tests, we have a large space. main :: IO () -main = do - let empty_test_opts = mempty :: TestOptions - let my_test_opts = empty_test_opts { - -- - -- Increase to 5000 when, - -- https://github.com/batterseapower/test-framework/issues/34 - -- is fixed. - -- - topt_maximum_generated_tests = Just 1000 - } - let empty_runner_opts = mempty :: RunnerOptions - let my_runner_opts = empty_runner_opts { - ropt_test_options = Just my_test_opts - } - - defaultMainWithOpts tests my_runner_opts +main = + defaultMain $ + localOption (QuickCheckTests 5000) $ + localOption (QuickCheckMaxRatio 50) tests -- 2.44.2