From d32fe2f0a6c83ba3046a405eda40f83c794c000d Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Sun, 21 Apr 2013 12:24:14 -0400 Subject: [PATCH] Use test-framework for the tests, and bump some dependencies. --- hath.cabal | 5 +- src/Cidr.hs | 146 ++++++++++++++++++++++++++++----------------- src/IPv4Address.hs | 17 ++++-- src/Octet.hs | 32 +++++----- test/TestSuite.hs | 56 ++++++++++------- 5 files changed, 159 insertions(+), 97 deletions(-) diff --git a/hath.cabal b/hath.cabal index 79639ce..2ea92c0 100644 --- a/hath.cabal +++ b/hath.cabal @@ -12,7 +12,10 @@ executable hath build-depends: base == 4.*, HUnit == 1.2.*, - QuickCheck == 2.4.* + QuickCheck == 2.6.*, + test-framework == 0.8.*, + test-framework-hunit == 0.3.*, + test-framework-quickcheck2 == 0.3.* main-is: Main.hs diff --git a/src/Cidr.hs b/src/Cidr.hs index a07117d..d41ba11 100644 --- a/src/Cidr.hs +++ b/src/Cidr.hs @@ -1,6 +1,7 @@ module Cidr ( Cidr(..), cidr_from_string, + cidr_properties, cidr_tests, combine_all, contains, @@ -19,8 +20,12 @@ module Cidr import Data.List (nubBy) import Data.Maybe (catMaybes, fromJust) -import Test.HUnit -import Test.QuickCheck + +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 qualified Bit as B import IPv4Address @@ -235,137 +240,151 @@ adjacent cidr1 cidr2 test_min_host1 :: Test test_min_host1 = - TestCase $ assertEqual "The minimum host in 10.0.0.0/24 is 10.0.0.0" - expected - actual + testCase desc $ + assertEqual desc + expected + actual where + desc = "The minimum host in 10.0.0.0/24 is 10.0.0.0" actual = show $ min_host (fromJust $ cidr_from_string "10.0.0.0/24") expected = "10.0.0.0" test_max_host1 :: Test test_max_host1 = - TestCase $ assertEqual "The maximum host in 10.0.0.0/24 is 10.0.0.255" - expected - actual + testCase desc $ + assertEqual desc + expected + actual where + desc = "The maximum host in 10.0.0.0/24 is 10.0.0.255" actual = show $ max_host (fromJust $ cidr_from_string "10.0.0.0/24") expected = "10.0.0.255" test_equality1 :: Test test_equality1 = - TestCase $ + testCase desc $ assertEqual - "10.1.1.0/23 equals itself" + desc True (cidr1 == cidr1) where + desc = "10.1.1.0/23 equals itself" cidr1 = fromJust $ cidr_from_string "10.1.1.0/23" test_contains1 :: Test test_contains1 = - TestCase $ + testCase desc $ assertEqual - "10.1.1.0/23 contains 10.1.1.0/24" + desc True (cidr1 `contains` cidr2) where + desc = "10.1.1.0/23 contains 10.1.1.0/24" cidr1 = fromJust $ cidr_from_string "10.1.1.0/23" cidr2 = fromJust $ cidr_from_string "10.1.1.0/24" test_contains2 :: Test test_contains2 = - TestCase $ + testCase desc $ assertEqual - "10.1.1.0/23 contains itself" + desc True (cidr1 `contains` cidr1) where + desc = "10.1.1.0/23 contains itself" cidr1 = fromJust $ cidr_from_string "10.1.1.0/23" test_contains_proper1 :: Test test_contains_proper1 = - TestCase $ + testCase desc $ assertEqual - "10.1.1.0/23 contains 10.1.1.0/24 properly" + desc True (cidr1 `contains_proper` cidr2) where + desc = "10.1.1.0/23 contains 10.1.1.0/24 properly" cidr1 = fromJust $ cidr_from_string "10.1.1.0/23" cidr2 = fromJust $ cidr_from_string "10.1.1.0/24" test_contains_proper2 :: Test test_contains_proper2 = - TestCase $ + testCase desc $ assertEqual - "10.1.1.0/23 does not contain itself properly" + desc False (cidr1 `contains_proper` cidr1) where + desc = "10.1.1.0/23 does not contain itself properly" cidr1 = fromJust $ cidr_from_string "10.1.1.0/23" test_adjacent1 :: Test test_adjacent1 = - TestCase $ + testCase desc $ assertEqual - "10.1.0.0/24 is adjacent to 10.1.1.0/24" + desc True (cidr1 `adjacent` cidr2) where + desc = "10.1.0.0/24 is adjacent to 10.1.1.0/24" cidr1 = fromJust $ cidr_from_string "10.1.0.0/24" cidr2 = fromJust $ cidr_from_string "10.1.1.0/24" test_adjacent2 :: Test test_adjacent2 = - TestCase $ + testCase desc $ assertEqual - "10.1.0.0/23 is not adjacent to 10.1.0.0/24" + desc False (cidr1 `adjacent` cidr2) where + desc = "10.1.0.0/23 is not adjacent to 10.1.0.0/24" cidr1 = fromJust $ cidr_from_string "10.1.0.0/23" cidr2 = fromJust $ cidr_from_string "10.1.0.0/24" test_adjacent3 :: Test test_adjacent3 = - TestCase $ + testCase desc $ assertEqual - "10.1.0.0/24 is not adjacent to 10.2.5.0/24" + desc False (cidr1 `adjacent` cidr2) where + desc = "10.1.0.0/24 is not adjacent to 10.2.5.0/24" cidr1 = fromJust $ cidr_from_string "10.1.0.0/24" cidr2 = fromJust $ cidr_from_string "10.2.5.0/24" test_adjacent4 :: Test test_adjacent4 = - TestCase $ + testCase desc $ assertEqual - "10.1.1.0/24 is not adjacent to 10.1.2.0/24" + desc False (cidr1 `adjacent` cidr2) where + desc = "10.1.1.0/24 is not adjacent to 10.1.2.0/24" cidr1 = fromJust $ cidr_from_string "10.1.1.0/24" cidr2 = fromJust $ cidr_from_string "10.1.2.0/24" test_combine_contained1 :: Test test_combine_contained1 = - TestCase $ + testCase desc $ assertEqual - "10.0.0.0/8, 10.1.0.0/16, and 10.1.1.0/24 combine to 10.0.0.0/8" + desc expected_cidrs (combine_contained test_cidrs) 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 = fromJust $ cidr_from_string "10.0.0.0/8" cidr2 = fromJust $ cidr_from_string "10.1.0.0/16" cidr3 = fromJust $ cidr_from_string "10.1.1.0/24" @@ -375,24 +394,27 @@ test_combine_contained1 = test_combine_contained2 :: Test test_combine_contained2 = - TestCase $ + testCase desc $ assertEqual - "192.168.3.0/23 does not contain 192.168.1.0/24" + desc [cidr1, cidr2] (combine_contained [cidr1, cidr2]) where + desc = "192.168.3.0/23 does not contain 192.168.1.0/24" cidr1 = fromJust $ cidr_from_string "192.168.3.0/23" cidr2 = fromJust $ cidr_from_string "192.168.1.0/24" test_combine_all1 :: Test test_combine_all1 = - TestCase $ + testCase desc $ assertEqual - "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" + desc expected_cidrs (combine_all test_cidrs) 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" cidr1 = fromJust $ cidr_from_string "10.0.0.0/24" cidr2 = fromJust $ cidr_from_string "10.0.1.0/24" cidr3 = fromJust $ cidr_from_string "10.0.2.0/24" @@ -404,12 +426,13 @@ test_combine_all1 = test_combine_all2 :: Test test_combine_all2 = - TestCase $ + testCase desc $ assertEqual - "127.0.0.1/32 combines with itself recursively" + desc expected_cidrs (combine_all test_cidrs) where + desc = "127.0.0.1/32 combines with itself recursively" cidr1 = fromJust $ cidr_from_string "127.0.0.1/32" expected_cidrs = [cidr1] test_cidrs = [cidr1, cidr1, cidr1, cidr1, cidr1] @@ -417,12 +440,14 @@ test_combine_all2 = test_combine_all3 :: Test test_combine_all3 = - TestCase $ + testCase desc $ assertEqual - "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" + desc expected_cidrs (combine_all test_cidrs) 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" cidr1 = fromJust $ cidr_from_string "10.0.0.16/32" cidr2 = fromJust $ cidr_from_string "10.0.0.17/32" cidr3 = fromJust $ cidr_from_string "10.0.0.18/32" @@ -431,24 +456,25 @@ test_combine_all3 = test_cidrs = [cidr1, cidr2, cidr3, cidr4] -cidr_tests :: [Test] -cidr_tests = [ test_min_host1, - test_max_host1, - test_equality1, - test_contains1, - test_contains2, - test_contains_proper1, - test_contains_proper2, - test_adjacent1, - test_adjacent2, - test_adjacent3, - test_adjacent4, - test_combine_contained1, - test_combine_contained2, - test_combine_all1, - test_combine_all2, - test_combine_all3 - ] +cidr_tests :: Test +cidr_tests = + testGroup "CIDR Tests" [ + test_min_host1, + test_max_host1, + test_equality1, + test_contains1, + test_contains2, + test_contains_proper1, + test_contains_proper2, + test_adjacent1, + test_adjacent2, + test_adjacent3, + test_adjacent4, + test_combine_contained1, + test_combine_contained2, + test_combine_all1, + test_combine_all2, + test_combine_all3 ] -- QuickCheck Tests @@ -462,3 +488,15 @@ prop_contains_proper_intransitive :: Cidr -> Cidr -> Property prop_contains_proper_intransitive cidr1 cidr2 = (cidr1 `contains_proper` cidr2) ==> (not (cidr2 `contains_proper` cidr1)) + +cidr_properties :: Test +cidr_properties = + testGroup "CIDR Properties" [ + testProperty + "All CIDRs contain themselves" + prop_all_cidrs_contain_themselves, + + testProperty + "contains_proper is intransitive" + prop_contains_proper_intransitive + ] diff --git a/src/IPv4Address.hs b/src/IPv4Address.hs index b46f18c..dac7dda 100644 --- a/src/IPv4Address.hs +++ b/src/IPv4Address.hs @@ -7,8 +7,10 @@ module IPv4Address ) where import Data.Maybe (fromJust) -import Test.HUnit -import Test.QuickCheck +import Test.HUnit (assertEqual) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.QuickCheck (Arbitrary(..), Gen) import Maskable import Maskbits @@ -304,10 +306,11 @@ mk_testaddr a b c d = test_most_sig_bit_different1 :: Test test_most_sig_bit_different1 = - TestCase $ assertEqual "10.1.1.0 and 10.1.0.0 differ in bit 24" + testCase desc $ assertEqual desc TwentyFour bit 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 @@ -316,16 +319,18 @@ test_most_sig_bit_different1 = test_most_sig_bit_different2 :: Test test_most_sig_bit_different2 = - TestCase $ assertEqual "10.1.2.0 and 10.1.1.0 differ in bit 23" + testCase desc $ assertEqual desc TwentyThree bit 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 -ipv4address_tests :: [Test] +ipv4address_tests :: Test ipv4address_tests = - [ test_most_sig_bit_different1, + testGroup "IPv4 Address Tests" [ + test_most_sig_bit_different1, test_most_sig_bit_different2 ] diff --git a/src/Octet.hs b/src/Octet.hs index 2e372fd..78413e6 100644 --- a/src/Octet.hs +++ b/src/Octet.hs @@ -2,8 +2,12 @@ module Octet where import Data.Maybe (fromJust) -import Test.HUnit -import Test.QuickCheck + +import Test.HUnit (assertEqual) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) + +import Test.QuickCheck (Arbitrary(..), Gen) import Bit as B import Maskable @@ -128,37 +132,35 @@ max_octet = -- HUnit Tests test_octet_from_int1 :: Test test_octet_from_int1 = - TestCase $ assertEqual "octet_from_int 128 should parse as 10000000" oct1 oct2 + testCase desc $ assertEqual desc oct1 oct2 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 = fromJust $ octet_from_int 128 test_octet_mask1 :: Test test_octet_mask1 = - TestCase $ - assertEqual - "The network bits of 255/4 should equal 240" - oct2 - (apply_mask oct1 Four B.Zero) + testCase desc $ + assertEqual desc oct2 (apply_mask oct1 Four B.Zero) where + desc = "The network bits of 255/4 should equal 240" oct1 = fromJust $ octet_from_int 255 oct2 = fromJust $ octet_from_int 240 test_octet_mask2 :: Test test_octet_mask2 = - TestCase $ - assertEqual - "The network bits of 255/1 should equal 128" - oct2 - (apply_mask oct1 Maskbits.One B.Zero) + testCase desc $ + assertEqual desc oct2 (apply_mask oct1 Maskbits.One B.Zero) where + desc = "The network bits of 255/1 should equal 128" oct1 = fromJust $ octet_from_int 255 oct2 = fromJust $ octet_from_int 128 -octet_tests :: [Test] +octet_tests :: Test octet_tests = - [ test_octet_from_int1, + testGroup "Octet Tests" [ + test_octet_from_int1, test_octet_mask1, test_octet_mask2 ] diff --git a/test/TestSuite.hs b/test/TestSuite.hs index d7cc5ff..3085c1b 100644 --- a/test/TestSuite.hs +++ b/test/TestSuite.hs @@ -1,32 +1,46 @@ {-# LANGUAGE NoMonomorphismRestriction #-} +import Data.Monoid (mempty) +import Test.Framework ( + RunnerOptions(), + Test, + TestName, + TestOptions(), + defaultMainWithOpts, + testGroup + ) +import Test.Framework.Options +import Test.Framework.Runners.Options +import Test.Framework.Providers.API (TestName) +import Test.Framework.Providers.HUnit (testCase) +import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit -import Test.QuickCheck (Args(..), quickCheckWith, stdArgs) +import Test.QuickCheck (Testable ()) -import Cidr (cidr_tests, - prop_all_cidrs_contain_themselves, - prop_contains_proper_intransitive) +import Cidr (cidr_properties, cidr_tests) import IPv4Address (ipv4address_tests) import Octet (octet_tests) --- The list of HUnit tests. -test_suite = TestList (concat [cidr_tests, - ipv4address_tests, - octet_tests]) +tests :: [Test.Framework.Test] +tests = [ cidr_properties, + cidr_tests, + ipv4address_tests, + octet_tests ] main :: IO () main = do - putStrLn "HUnit" - putStrLn "-----" - runTestTT test_suite + 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 + } - putStrLn "" - - putStrLn "QuickCheck" - putStrLn "----------" - qc prop_all_cidrs_contain_themselves - qc prop_contains_proper_intransitive - where - args :: Args - args = stdArgs { maxDiscard = 5000 } - qc = quickCheckWith args + defaultMainWithOpts tests my_runner_opts -- 2.44.2