Add a skeleton test suite.

diff --git a/haeredes.cabal b/haeredes.cabal
index b53cb947f904983ba3aac0c7385f51f41821d2b9..1851e78389e0dc42e6116f760cd9fef9b9de003b 100644 (file)
--- 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 02e5a5524b866eb646102a544bcc0719a154080c..cda8b96274414d6bd90b6dd71bf8d5f1f08e2309 100644 (file)
--- 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 ]