From: Michael Orlitzky Date: Wed, 31 Jul 2013 19:41:41 +0000 (-0400) Subject: Add a skeleton test suite. X-Git-Tag: 0.2.0~15 X-Git-Url: http://gitweb.michael.orlitzky.com/?p=haeredes.git;a=commitdiff_plain;h=4f6bb3da01e7136f1e17a7d2d28518eefe18fc36 Add a skeleton test suite. --- diff --git a/haeredes.cabal b/haeredes.cabal index b53cb94..1851e78 100644 --- a/haeredes.cabal +++ b/haeredes.cabal @@ -75,7 +75,11 @@ executable haeredes dns >= 0.3.7, iproute == 1.2.*, MissingH == 1.2.*, - parallel-io == 0.3.* + parallel-io == 0.3.*, + -- Test deps + HUnit == 1.2.*, + test-framework == 0.8.*, + test-framework-hunit == 0.3.* main-is: Main.hs @@ -104,6 +108,41 @@ executable haeredes -optc-O3 -optc-march=native +test-suite testsuite + type: exitcode-stdio-1.0 + hs-source-dirs: src test + main-is: TestSuite.hs + build-depends: + base == 4.*, + bytestring == 0.10.*, + cmdargs == 0.10.*, + dns >= 0.3.7, + iproute == 1.2.*, + MissingH == 1.2.*, + parallel-io == 0.3.*, + -- Test deps + HUnit == 1.2.*, + test-framework == 0.8.*, + test-framework-hunit == 0.3.* + + -- It's not entirely clear to me why I have to reproduce all of this. + ghc-options: + -Wall + -fwarn-hi-shadowing + -fwarn-missing-signatures + -fwarn-name-shadowing + -fwarn-orphans + -fwarn-type-defaults + -fwarn-tabs + -fwarn-incomplete-record-updates + -fwarn-monomorphism-restriction + -fwarn-unused-do-bind + -rtsopts + -threaded + -optc-O3 + -optc-march=native + + source-repository head type: git location: http://michael.orlitzky.com/git/haeredes.git diff --git a/src/DNS.hs b/src/DNS.hs index 02e5a55..cda8b96 100644 --- a/src/DNS.hs +++ b/src/DNS.hs @@ -1,5 +1,6 @@ module DNS ( LookupResult, + dns_tests, lookupMX', lookupNS', normalize, @@ -31,6 +32,9 @@ import Network.DNS ( rdata, rrtype, withResolver ) +import Test.Framework (Test, testGroup) +import Test.Framework.Providers.HUnit (testCase) +import Test.HUnit (assertEqual) import Text.Read (readMaybe) type LookupResult = (Domain, Maybe [Domain]) @@ -112,3 +116,18 @@ normalize_root d normalize_case :: Domain -> Domain normalize_case = BS.map toLower + + +test_normalize_case :: Test +test_normalize_case = + testCase desc $ + assertEqual desc expected actual + where + desc = "normalize_case lowercases DNS names" + expected = BS.pack "example.com" + actual = normalize_case $ BS.pack "ExAmPlE.COM" + +dns_tests :: Test +dns_tests = + testGroup "DNS Tests" [ + test_normalize_case ]